Index: palm/trunk/SOURCE/Makefile
===================================================================
--- palm/trunk/SOURCE/Makefile	(revision 3297)
+++ palm/trunk/SOURCE/Makefile	(revision 3298)
@@ -25,4 +25,9 @@
 # -----------------
 # $Id$
+# Added missing dependencies and replaced blanks with tabs (forkel)
+# Added chemistry emission module (Russo)
+# Added chemistry_model_mod to flow_statistics (basit)
+#
+# 3294 2018-10-01 02:37:10Z raasch
 # changes related to modularization of the ocean mode,
 # bugfix: dependency to advec_ws was missed in chemistry_model_mod
@@ -473,4 +478,5 @@
 	check_open.f90 \
 	check_parameters.f90 \
+	chem_emissions_mod.f90 \
 	chem_gasphase_mod.f90 \
 	chemistry_model_mod.f90 \
@@ -576,5 +582,5 @@
 	random_gauss.f90 \
 	random_generator_parallel_mod.f90 \
-        read_restart_data_mod.f90 \
+	read_restart_data_mod.f90 \
 	run_control.f90 \
 	set_slicer_attributes_dvrp.f90 \
@@ -636,5 +642,5 @@
 	wind_turbine_model_mod.f90 \
 	wrd_write_string.f90 \
-        write_restart_data_mod.f90
+	write_restart_data_mod.f90
 
 
@@ -757,4 +763,5 @@
 	bulk_cloud_model_mod.o \
 	chemistry_model_mod.o \
+	chem_emissions_mod.o \
 	gust_mod.o \
 	init_vertical_profiles.o \
@@ -778,13 +785,23 @@
 	vertical_nesting_mod.o \
 	wind_turbine_model_mod.o
+chem_emissions_mod.o: \
+	chem_gasphase_mod.o \
+	chem_modules.o \
+	date_and_time_mod.o \
+	mod_kinds.o \
+	modules.o \
+	netcdf_data_input_mod.o \
+	surface_mod.o
 chemistry_model_mod.o: \
 	advec_ws.o \
 	chem_gasphase_mod.o \
 	chem_modules.o \
+	date_and_time_mod.o \
 	diffusion_s.o \
 	mod_kinds.o \
 	modules.o \
 	netcdf_data_input_mod.o \
-	surface_mod.o
+	surface_mod.o \
+	user_module.o
 chem_gasphase_mod.o: \
 	mod_kinds.o \
@@ -831,4 +848,5 @@
 	basic_constants_and_equations_mod.o \
 	bulk_cloud_model_mod.o \
+	chemistry_model_mod.o \
 	cpulog_mod.o \
 	mod_kinds.o \
@@ -868,4 +886,5 @@
 	basic_constants_and_equations_mod.o \
 	bulk_cloud_model_mod.o \
+	chemistry_model_mod.o\
 	cpulog_mod.o \
 	gust_mod.o \
@@ -942,4 +961,5 @@
 	basic_constants_and_equations_mod.o \
 	bulk_cloud_model_mod.o \
+	chemistry_model_mod.o \
 	cpulog_mod.o \
 	gust_mod.o \
@@ -960,4 +980,5 @@
 	basic_constants_and_equations_mod.o \
 	bulk_cloud_model_mod.o \
+	chemistry_model_mod.o \
 	cpulog_mod.o \
 	date_and_time_mod.o \
@@ -986,5 +1007,5 @@
 	basic_constants_and_equations_mod.o \
 	bulk_cloud_model_mod.o \
-	chemistry_model_mod.o \
+	chem_emissions_mod.o \
 	cpulog_mod.o \
 	disturb_heatflux.o \
@@ -1217,5 +1238,6 @@
 	basic_constants_and_equations_mod.o \
 	mod_kinds.o \
-	modules.o
+	modules.o \
+	time_to_string.o
 modules.o: \
 	mod_kinds.o
@@ -1233,4 +1255,5 @@
 	mod_kinds.o
 netcdf_data_input_mod.o: \
+	chem_modules.o \
 	cpulog_mod.o \
 	mod_kinds.o \
@@ -1274,4 +1297,5 @@
 	chem_photolysis_mod.o \
 	cpulog_mod.o \
+	date_and_time_mod.o \
 	land_surface_model_mod.o \
 	mod_kinds.o \
@@ -1282,4 +1306,5 @@
 	pmc_particle_interface.o \
 	surface_layer_fluxes_mod.o \
+	time_to_string.o \
 	write_restart_data_mod.o
 parin.o: \
@@ -1545,4 +1570,5 @@
 	buoyancy.o \
 	calc_mean_profile.o \
+	chem_emissions_mod.o \
 	chemistry_model_mod.o \
 	chem_modules.o \
@@ -1558,5 +1584,5 @@
 	modules.o \
 	multi_agent_system_mod.o \
- ocean_mod.o \
+	ocean_mod.o \
 	pmc_interface_mod.o \
 	prognostic_equations.o \
@@ -1567,4 +1593,5 @@
 	surface_mod.o \
 	synthetic_turbulence_generator_mod.o \
+	time_to_string.o \
 	turbulence_closure_mod.o\
 	urban_surface_mod.o \
@@ -1584,4 +1611,5 @@
 	radiation_model_mod.o \
 	surface_layer_fluxes_mod.o \
+	time_to_string.o \
 	urban_surface_mod.o
 time_to_string.o: \
Index: palm/trunk/SOURCE/advec_ws.f90
===================================================================
--- palm/trunk/SOURCE/advec_ws.f90	(revision 3297)
+++ palm/trunk/SOURCE/advec_ws.f90	(revision 3298)
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! Add formatted note from ketelsen about statistics for chemistry
+!
+! 3294 2018-10-01 02:37:10Z raasch
 ! ocean renamed ocean_mode
 ! 
@@ -1697,4 +1700,8 @@
                     ) * weight_substep(intermediate_timestep_count)
              ENDDO
+
+!          CASE ( 'kc' )
+          !kk Has to be implemented for kpp chemistry
+
 
          END SELECT
Index: palm/trunk/SOURCE/check_parameters.f90
===================================================================
--- palm/trunk/SOURCE/check_parameters.f90	(revision 3297)
+++ palm/trunk/SOURCE/check_parameters.f90	(revision 3298)
@@ -25,4 +25,14 @@
 ! -----------------
 ! $Id: check_parameters.f90 2520 2017-10-05 13:50:26Z gronemeier &
+! - Minor formatting and remarks
+! - Call of chem_emissions_check_parameters commented 
+!   (preliminary, as there is still a bug in this subroutine) (forkel)
+! - Corrected call for chemistry profile output added (basit)
+! - Call for init_vertical_profiles for chemistry removed (basit)
+! - Call for chem_init_profiles removed (basit)
+! - Setting of initial profiles for chemstry (constant and call of 
+!   init_vertical_profiles) commented (forkel)
+!
+! 2520 2017-10-05 13:50:26Z gronemeier
 ! changes concerning modularization of ocean option,
 ! init_vertical_profiles moved to separate file to avoid circular dependency
@@ -679,9 +689,12 @@
                bcm_check_data_output_pr
 
+    USE chem_emissions_mod,                                                    &
+        ONLY:  chem_emissions_check_parameters
+
+    USE chem_modules
+
     USE chemistry_model_mod,                                                   &
         ONLY:  chem_boundary_conds, chem_check_data_output,                    &
-               chem_check_data_output_pr, chem_species
-
-    USE chem_modules
+               chem_check_data_output_pr, chem_check_parameters, chem_species
 
     USE control_parameters
@@ -1443,5 +1456,12 @@
     ENDIF
 
-!
+!   Check for chem_emission_mod parameters setting
+!   IF ( air_chemistry ) CALL chem_emissions_check_parameters   ! forkel preliminary
+
+
+!   Check for chemitry_model_mod parameters setting
+    IF ( air_chemistry )  CALL chem_check_parameters
+
+
 !-- Check the module settings
     IF ( ocean_mode )  CALL ocean_check_parameters
@@ -1468,9 +1488,13 @@
        IF ( humidity       )  q_init  = q_surface
        IF ( passive_scalar )  s_init  = s_surface
-       IF ( air_chemistry )  THEN
-         DO lsp = 1, nvar
-            chem_species(lsp)%conc_pr_init = cs_surface(lsp)      
-         ENDDO
-       ENDIF
+!
+!--    TODO
+!--    Russo: Is done in chem_init and would overwrite what is done there
+!--    --> kanani: Revise
+!      IF ( air_chemistry )  THEN
+!        DO lsp = 1, nvar
+!           chem_species(lsp)%conc_pr_init = cs_surface(lsp)      
+!        ENDDO
+!      ENDIF
 !
 !--
@@ -1683,14 +1707,7 @@
        ENDIF
 !
+!--    TODO
 !--    Compute initial chemistry profile using the given chemical species gradients
-       IF ( air_chemistry )  THEN                                                          
-          DO  lsp = 1, nvar
-            CALL init_vertical_profiles( cs_vertical_gradient_level_ind(lsp,:),&
-                                         cs_vertical_gradient_level(lsp,:),    &
-                                         cs_vertical_gradient(lsp,:),          &
-                                         chem_species(lsp)%conc_pr_init,       &
-                                         cs_surface(lsp), bc_cs_t_val(lsp) )
-          ENDDO
-       ENDIF
+!--    Russo: Is done in chem_init --> kanani: Revise
 
     ENDIF
Index: palm/trunk/SOURCE/chem_emissions_mod.f90
===================================================================
--- palm/trunk/SOURCE/chem_emissions_mod.f90	(revision 3298)
+++ palm/trunk/SOURCE/chem_emissions_mod.f90	(revision 3298)
@@ -0,0 +1,1632 @@
+!> @file chem_emissions_mod.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM model system.
+!
+! PALM is free software: you can redistribute it and/or modify it under the
+! terms of the GNU General Public License as published by the Free Software
+! Foundation, either version 3 of the License, or (at your option) any later
+! version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 2018-2018 Leibniz Universitaet Hannover
+! Copyright 2018-2018 Freie Universitaet Berlin
+! Copyright 2018-2018 Karlsruhe Institute of Technology
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! ------------------
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+! Initial revision
+!
+! 3286 2018-09-28 07:41:39Z forkel
+!
+! Authors:
+! --------
+! Emmanuele Russo Fu-Berlin
+! Sabine Banzhaf  FU-Berlin
+! Martijn Schaap  FU-Berlin, TNO Utrecht
+! 
+! Description:
+! ------------
+!>  MODULE for reading-in Chemistry Emissions data
+!>
+!> @todo Check_parameters routine should be developed: for now it includes just one condition
+!> @todo Add option for capital or small letters in the matching routine
+!> @todo Use of Restart files not contempled at the moment
+!> @note <Enter notes on the module>
+!> @bug  <Enter known bugs here>
+!------------------------------------------------------------------------------!
+
+ MODULE chem_emissions_mod
+
+    USE arrays_3d,                                                             &
+       ONLY: rho_air
+
+    USE control_parameters,                                                    &
+       ONLY:  initializing_actions,end_time, message_string,                   &
+              intermediate_timestep_count, dt_3d
+ 
+    USE indices
+
+    USE kinds
+
+#if defined ( __netcdf )
+
+    USE netcdf_data_input_mod,                                                  &
+       ONLY: chem_emis_att_type, chem_emis_val_type
+
+    USE NETCDF
+
+#endif
+
+    USE date_and_time_mod,                                                      &
+       ONLY: time_default_indices, month_of_year, day_of_month, hour_of_day,    &
+             index_mm, index_dd, index_hh
+
+    USE chem_gasphase_mod,                                                      &
+       ONLY: spc_names
+ 
+    USE chem_modules
+
+    USE statistics,                                                             &   
+           ONLY:  weight_pres
+
+    IMPLICIT NONE
+
+!-- Declare all global variables within the module 
+    
+    CHARACTER (LEN=80)                               :: filename_emis                   !> Variable for the name of the netcdf input file
+    CHARACTER (LEN=80), ALLOCATABLE, DIMENSION(:)    :: string_values                   !> Output of string variables read from netcdf input file
+
+    INTEGER(iwp)                                     :: n_dims                          !> Number of dimensions of input variable netcdf file
+    INTEGER(iwp)                                     :: i                               !> index 1st selected dimension (some dims are not spatial)
+    INTEGER(iwp)                                     :: j                               !> index 2nd selected dimension 
+    INTEGER(iwp)                                     :: i_start                         !> Index to start read variable from netcdf along one dims
+    INTEGER(iwp)                                     :: i_end                           !> Index to end read variable from netcdf in one dims
+    INTEGER(iwp)                                     :: j_start                         !> Index to start read variable from netcdf in additional dims
+    INTEGER(iwp)                                     :: j_end                           !> Index to end read variable from netcdf in additional dims
+    INTEGER(iwp)                                     :: z_start                         !> Index to start read variable from netcdf in additional dims
+    INTEGER(iwp)                                     :: z_end                           !> Index to end read variable from netcdf in additional     dims
+    INTEGER(iwp), ALLOCATABLE, DIMENSION(:)          :: id_dims                         !> id of dimension of selected variable netcdf input
+    INTEGER(iwp), ALLOCATABLE, DIMENSION(:)          :: dum_var                         !> value of variable read from netcdf input
+    INTEGER(iwp)                                     :: id_ncfile                       !> id netcdf file 
+    INTEGER(iwp)                                     :: errno                           !> error number NF90_???? function
+    INTEGER(iwp)                                     :: id_var                          !< variable id
+    INTEGER(iwp)                                     :: dt_emis                         !> Time Step Emissions 
+    INTEGER(iwp)                                     :: len_index                       !> length of index (used for several indices)
+    INTEGER(iwp)                                     :: len_index_voc                   !> length of voc index
+    INTEGER(iwp)                                     :: len_index_pm                    !> length of PMs index
+    REAL(wp)                                         :: con_factor                      !> Units Conversion Factor
+ 
+
+    ! ---------------------------------------------------------------
+    ! Set Values of molecules, mols, etc
+    ! ---------------------------------------------------------------
+  
+    !> Avogadro number
+    REAL, PARAMETER        ::  Avog = 6.02205e23    ! mlc/mol
+ 
+    !> Dobson units:
+    REAL, PARAMETER        ::  Dobs = 2.68668e16    ! (mlc/cm2) / DU
+   
+    ! molar weights of components
+  
+    !> atomic weights:  
+    REAL, PARAMETER        ::  xm_H     =    1.00790e-3               ! kg/mol
+    REAL, PARAMETER        ::  xm_N     =   14.00670e-3               ! kg/mol
+    REAL, PARAMETER        ::  xm_C     =   12.01115e-3               ! kg/mol
+    REAL, PARAMETER        ::  xm_S     =   32.06400e-3               ! kg/mol
+    REAL, PARAMETER        ::  xm_O     =   15.99940e-3               ! kg/mol
+    REAL, PARAMETER        ::  xm_F     =   18.99840e-3               ! kg/mol
+    REAL, PARAMETER        ::  xm_Na    =   22.98977e-3               ! kg/mol
+    REAL, PARAMETER        ::  xm_Cl    =   35.45300e-3               ! kg/mol
+    REAL, PARAMETER        ::  xm_Rn222 =  222.00000e-3               ! kg/mol
+    REAL, PARAMETER        ::  xm_Pb210 =  210.00000e-3               ! kg/mol
+    REAL, PARAMETER        ::  xm_Ca    =   40.07800e-3               ! kg/mol
+    REAL, PARAMETER        ::  xm_K     =   39.09800e-3               ! kg/mol
+    REAL, PARAMETER        ::  xm_Mg    =   24.30500e-3               ! kg/mol
+    REAL, PARAMETER        ::  xm_Pb    =  207.20000e-3               ! kg/mol
+    REAL, PARAMETER        ::  xm_Cd    =  112.41000e-3               ! kg/mol
+    REAL, PARAMETER        ::  xm_Rh    =  102.90550e-3               ! kg/mol
+  
+    !> molecule weights:
+    REAL, PARAMETER        ::  xm_h2o   = xm_H * 2 + xm_O             ! kg/mol
+    REAL, PARAMETER        ::  xm_o3    = xm_O * 3                    ! kg/mol
+    REAL, PARAMETER        ::  xm_N2O5  = xm_N * 2 + xm_O * 5         ! kg/mol
+    REAL, PARAMETER        ::  xm_HNO3  = xm_H + xm_N + xm_O * 3      ! kg/mol
+    REAL, PARAMETER        ::  xm_NH4   = xm_N + xm_H * 4             ! kg/mol
+    REAL, PARAMETER        ::  xm_SO4   = xm_S + xm_O * 4             ! kg/mol
+    REAL, PARAMETER        ::  xm_NO3   = xm_N + xm_O * 3             ! kg/mol
+    REAL, PARAMETER        ::  xm_CO2   = xm_C + xm_O * 2             ! kg/mol
+    
+    !> mass of air
+    REAL, PARAMETER        ::  xm_air   =  28.964e-3                  ! kg/mol
+    REAL, PARAMETER        ::  xmair    =  28.94                      ! g/mol; old name!
+
+    !> sesalt composition:
+    ! (Seinfeld and Pandis, "Atmospheric Chemistry and Physics",
+    !  table 7.8 "Composition of Sea-Salt", p. 444)
+    REAL, PARAMETER        ::  massfrac_Cl_in_seasalt  = 0.5504       ! (kg Cl )/(kg seasalt)
+    REAL, PARAMETER        ::  massfrac_Na_in_seasalt  = 0.3061       ! (kg Na )/(kg seasalt)
+    REAL, PARAMETER        ::  massfrac_SO4_in_seasalt = 0.0768       ! (kg SO4)/(kg seasalt)
+  
+    !> other numbers 
+    REAL, PARAMETER        ::  xm_seasalt =  74.947e-3                ! kg/mol : NaCl, SO4, ..
+    REAL, PARAMETER        ::  rho_seasalt = 2.2e3                    ! kg/m3
+
+    !> * amonium sulphate
+  
+    REAL, PARAMETER        ::  xm_NH4HSO4  =  xm_NH4 + xm_H + xm_SO4  ! kg/mol
+    REAL, PARAMETER        ::  rho_NH4HSO4a = 1.8e3                   ! kg/m3
+
+    ! ---------------------------------------------------------------
+    ! gas
+    ! ---------------------------------------------------------------
+  
+    !> gas constant                        
+    REAL, PARAMETER        ::  Rgas = 8.3144     ! J/mol/K
+  
+    !> gas constant for dry air
+    REAL, PARAMETER        ::  Rgas_air = Rgas / xm_air   ! J/kg/K
+  
+    !> water vapour
+    REAL, PARAMETER        ::  Rgas_h2o = Rgas / xm_h2o   ! J/kg/K
+  
+    !> standard pressure
+    REAL, PARAMETER        ::  p0 = 1.0e5    ! Pa
+
+    !> sea-level pressure
+    REAL, PARAMETER        ::  p_sealevel = 1.01325e5    ! Pa  <-- suggestion Bram Bregman
+
+    !> global mean pressure
+    REAL, PARAMETER        ::  p_global = 98500.0   ! Pa
+
+    !> specific heat of dry air at constant pressure
+    REAL, PARAMETER        ::  cp_air = 1004.0           ! J/kg/K
+
+    !> Latent heat of evaporation
+    REAL, PARAMETER        ::  lvap = 2.5e6     !  [J kg-1]
+
+    !> Latent heat of condensation at 0 deg Celcius
+    !  (heat (J) necesarry to evaporate 1 kg of water)
+    REAL, PARAMETER        ::  Lc = 22.6e5           ! J/kg
+  
+    !> kappa = R/cp = 2/7
+    REAL, PARAMETER        ::  kappa = 2.0/7.0
+
+    !> Von Karman constant (dry_dep)
+    REAL, PARAMETER        ::  vkarman = 0.4
+
+    !> Boltzmann constant:
+    REAL, PARAMETER        ::  kbolz = 1.38066e-23_wp    ! J/K
+
+    !> Inverse Reference Pressure (1/Pa)    
+    REAL(wp), PARAMETER     ::  pref_i  = 1.0_wp / 100000.0_wp       
+ 
+    !>
+    REAL(wp), PARAMETER     ::  r_cp    = 0.286_wp                  !< R / cp (exponent for potential temperature)
+
+
+    SAVE
+
+!-- Interfaces Part
+
+!-- Checks Input parameters
+    INTERFACE chem_emissions_check_parameters
+       MODULE PROCEDURE chem_emissions_check_parameters
+    END INTERFACE chem_emissions_check_parameters
+
+!-- Reading of NAMELIST parameters
+!    INTERFACE chem_emissions_parin
+!       MODULE PROCEDURE chem_emissions_parin
+!    END INTERFACE chem_emissions_parin
+
+!-- Output of information to the header file
+!    INTERFACE chem_emissions_header
+!       MODULE PROCEDURE chem_emissions_header
+!    END INTERFACE chem_emissions_header
+
+!-- Matching Emissions actions  
+    INTERFACE chem_emissions_match
+       MODULE PROCEDURE chem_emissions_match
+    END INTERFACE chem_emissions_match
+
+!-- Initialization actions  
+    INTERFACE chem_emissions_init
+       MODULE PROCEDURE chem_emissions_init
+    END INTERFACE chem_emissions_init
+
+!-- Setup of Emissions
+    INTERFACE chem_emissions_setup
+       MODULE PROCEDURE chem_emissions_setup
+    END INTERFACE chem_emissions_setup
+
+
+!-- Public Interfaces
+    PUBLIC chem_emissions_init,chem_emissions_match,chem_emissions_setup
+
+!-- Public Variables
+
+    PUBLIC id_ncfile,errno,id_dims,n_dims,dum_var, con_factor,   &
+           len_index,len_index_voc,len_index_pm, string_values
+ CONTAINS
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Routine for checking input parameters
+!------------------------------------------------------------------------------!
+ SUBROUTINE chem_emissions_check_parameters
+
+
+!TBD: Where Should we put the call to chem_emissions_check_parameters? In chem_init or in check_parameters?
+
+    IMPLICIT NONE
+
+    INTEGER(iwp)           ::  tmp
+
+    TYPE(chem_emis_att_type)   ::  emt
+!
+!--    Call routine for controlling chem_emissions namelist 
+!    CALL chem_emissions_parin
+
+!TBD: In case the given emission values do not coincide with the passed names we should think of a solution: 
+!  I would personally do that if the name of the species differ from the number of emission values, I would 
+!  print a warning that says that in correspondance of that particular species the value is zero. 
+!  An alternative would be to initialize the cs_surface_flux values to a negative number. 
+
+!-- Check Emission Species Number equal to number of passed names for the chemistry species: 
+   IF ( SIZE(emt%species_name) /= emt%nspec  )  THEN
+
+       message_string = 'Numbers of input emission species names and number of species'             //          &
+                         'for which emission values are given do not match'                  
+       CALL message( 'chem_emissions_check_parameters', 'CM0437', 2, 2, 0, 6, 0 ) 
+
+
+    ENDIF
+
+    !-- Check Emission Species Number equals to number of passed names for the species
+    !IF ( SIZE(emt%species_name) /= SIZE(emt%species_index)  )  THEN
+    !      message_string = 'Number of input emission species names and '             //          &
+    !                       ' number of passed species indices do not match'                  
+    !      CALL message( 'chem_emissions_check_parameters', 'CM0101', 2, 2, 0, 6, 0 ) 
+
+    !ENDIF
+
+    !-- Check Emission Categories
+!    IF ( SIZE(chem_emis%cat_name) /= SIZE(chem_emis%cat_index)  )  THEN
+!       WRITE( message_string, * )                                                        &
+!       'Number of input emission categories name and categories index does not match\\'  
+!       CALL message( 'chem_emissions_check_parameters', 'CM0101', 1, 2, 0, 6, 0 ) 
+!    ENDIF
+
+
+
+    !TBD: Check which other consistency controls should be included
+
+   !TBD: Include check for spatial dimension of netcdf file. If they do not match with the ones 
+   !     of the simulation, the model should print an error.  
+
+END SUBROUTINE chem_emissions_check_parameters
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Matching the chemical species indices. The routine checks what are the indices of the emission input species 
+!  and the corresponding ones of the model species. The routine gives as output a vector containing the number 
+!  of common species: it is important to note that while the model species are distinct, their values could be 
+!  given to a single species in input: for example, in the case of NO2 and NO, values may be passed in input as NOx values.
+!------------------------------------------------------------------------------!
+SUBROUTINE chem_emissions_match(emt_att,len_index)   
+
+
+    INTEGER(iwp), INTENT(INOUT)              ::  len_index        !< Variable where to store the number of common species between the input dataset and the model species   
+
+    TYPE(chem_emis_att_type), INTENT(INOUT)  ::  emt_att          !< Chemistry Emission Array containing information for all the input chemical emission species
+   
+    INTEGER(iwp)                             ::  ind_mod, ind_inp !< Parameters for cycling through chemical model and input species 
+    INTEGER(iwp)                             ::  nspec_emis_inp   !< Variable where to store the number of the emission species in input
+
+    INTEGER(iwp)                             ::  ind_voc          !< Indices to check whether a split for voc should be done
+
+    INTEGER(iwp)                             ::  ispec            !> index for cycle over effective number of emission species
+
+
+    !> Tell the user where we are!!
+    CALL location_message( 'Matching input emissions and model chemistry species', .FALSE. )
+
+    !> Number of input emission species.
+
+    nspec_emis_inp=emt_att%nspec 
+
+    !> Check the emission mode: DEFAULT, PRE-PROCESSED or PARAMETERIZED  !TBD: Add option for capital or small letters
+    SELECT CASE(TRIM(mode_emis)) 
+
+       !> PRE-PROCESSED case: in this case the input species have to coincide with the ones of the model (except VOCs for which we have the VOC split): NO and NO2 in input and not NOx.
+       CASE ("PRE-PROCESSED")
+
+          CALL location_message( 'chem_emissions PRE-PROCESSED_mode_matching', .FALSE. )
+
+          len_index=0
+          len_index_voc=0 
+
+          !> The first condition is that both the number of model and input emissions species are not null 
+          IF ( (SIZE(spc_names) .GT. 0) .AND. (nspec_emis_inp .GT. 0)) THEN
+
+             !> Cycle over model species
+             DO ind_mod = 1, SIZE(spc_names)
+                !> Cycle over Input species  
+                DO ind_inp = 1, nspec_emis_inp
+
+           !> In the PRE-PROCESSED mode each emission species is given input values, made exception for the VOCs, having the total number of VOCs in input: the model then executes a split through the different VOC species
+                   ! > Check for VOC Species: In input in this case we only have one species (VOC)  
+                   IF (TRIM(emt_att%species_name(ind_inp))=="VOC") THEN
+                      !> Cycle over the input voc species: they have to be one of the VOCs of the mechanism used. A list of VOC species for different mechanisms is provided in the module documentation
+                      DO ind_voc= 1,emt_att%nvoc
+                         !> Determine the indices of the coinciding species in the two cases and assign them to matching arrays 
+                         IF (TRIM(emt_att%voc_name(ind_voc))==TRIM(spc_names(ind_mod))) THEN
+                            len_index=len_index+1
+                            len_index_voc=len_index_voc+1
+                         ENDIF
+                      END DO
+                   ENDIF
+                   !> Other Species
+                   IF (TRIM(emt_att%species_name(ind_inp))==TRIM(spc_names(ind_mod))) THEN
+                      len_index=len_index+1
+                   ENDIF
+                ENDDO
+             ENDDO
+
+             !> Allocate array for storing the indices of the matched species
+             IF (len_index>0) THEN
+ 
+                ALLOCATE(match_spec_input(len_index)) 
+ 
+                ALLOCATE(match_spec_model(len_index))
+
+                IF (len_index_voc>0) THEN
+
+                   ALLOCATE(match_spec_voc_model(len_index_voc))   !> Contains indices of the VOC model species 
+
+                   ALLOCATE(match_spec_voc_input(len_index_voc))   !> In input there is only one value for VOCs in the DEFAULT mode. This array contains the indices of the different values of VOC compositions of the input variable VOC_composition
+
+                ENDIF
+
+                !> Repeat the same cycle of above but passing the species indices to the newly declared arrays
+                len_index=0
+
+                !> Cycle over model species
+                DO ind_mod = 1, SIZE(spc_names)  
+                   !> Cycle over Input species  
+                   DO ind_inp = 1, nspec_emis_inp
+
+                   !> Determine the indices of the coinciding species in the two cases and assign them to matching arrays 
+
+                      ! > VOCs
+                      IF ( TRIM(emt_att%species_name(ind_inp))=="VOC" .AND. ALLOCATED(match_spec_voc_input) ) THEN      
+                         DO ind_voc= 1,emt_att%nvoc
+                            IF (TRIM(emt_att%voc_name(ind_voc))==TRIM(spc_names(ind_mod))) THEN
+                               len_index=len_index+1
+                               len_index_voc=len_index_voc+1
+                        
+                               match_spec_input(len_index)=ind_inp
+                               match_spec_model(len_index)=ind_mod
+
+                               match_spec_voc_input(len_index_voc)=ind_voc
+                               match_spec_voc_model(len_index_voc)=ind_mod                         
+                            ENDIF
+                         END DO
+                      ENDIF
+
+                      !>Other Species
+                      IF (TRIM(emt_att%species_name(ind_inp))==TRIM(spc_names(ind_mod))) THEN
+                         len_index=len_index+1
+                         match_spec_input(len_index)=ind_inp
+                         match_spec_model(len_index)=ind_mod
+                      ENDIF
+                   END DO
+                END DO
+
+             !> In the case there are no species matching, the emission module should not be called
+             ELSE
+
+                message_string = 'Given Chemistry Emission Species'            //          &
+                                 ' DO NOT MATCH'                                //          &
+                                 ' model chemical species:'                      //          &
+                                 ' Chemistry Emissions routine is not called'  
+                CALL message( 'chem_emissions_matching', 'CM0438', 0, 0, 0, 6, 0 )
+             ENDIF !> IF (len_index>0)
+ 
+          ELSE
+
+             !In this case either spc_names is null or nspec_emis_inp is not allocated
+
+             message_string = 'Array of Emission species not allocated:'             //          &
+                              ' Either no emission species are provided as input or'  //          &
+                              ' no chemical species are used by PALM:'                //          &
+                              ' Chemistry Emissions routine is not called'                  
+             CALL message( 'chem_emissions_matching', 'CM0439', 0, 2, 0, 6, 0 ) 
+
+          ENDIF !> IF ( (SIZE(spc_names) .GT. 0) .AND. ALLOCATED(nspec_emis_inp))
+
+       !> ------------------------------------------------------------------
+       !> DEFAULT case
+
+       CASE ("DEFAULT")
+
+          CALL location_message( 'chem_emissions DEFAULT_mode_matching', .FALSE. )
+
+          len_index=0      !>  index for TOTAL number of species   
+          len_index_voc=0  !>  index for TOTAL number of VOCs
+          len_index_pm=3   !>  index for TOTAL number of PM Types: PM1, PM2.5, PM10. It is needed because the number of emission inputs and the one of PMs in the model may not be the same.
+
+          !> The first condition is that both the number of model and input emissions species are not null 
+          IF ( (SIZE(spc_names) .GT. 0) .AND. (nspec_emis_inp .GT. 0) ) THEN
+
+             !> Cycle over model species
+             DO ind_mod = 1, SIZE(spc_names)
+                !> Cycle over input species
+                DO ind_inp = 1, nspec_emis_inp
+
+                   ! > Check for VOC Species: In input in this case we only have one species (VOC)  
+                   IF (TRIM(emt_att%species_name(ind_inp))=="VOC") THEN
+                      !> Cycle over the voc species given in input: they have to be one of the VOCs of the mechanism used. A list of VOC species for different mechanisms is provided in the module documentation 
+                      DO ind_voc= 1,emt_att%nvoc
+                         !> Determine the indices of the coinciding species in the two cases and assign them to matching arrays 
+                         IF (TRIM(emt_att%voc_name(ind_voc))==TRIM(spc_names(ind_mod))) THEN
+                            len_index=len_index+1
+                            len_index_voc=len_index_voc+1
+                         ENDIF
+                      END DO
+                   ENDIF
+
+                   !> PMs: For PMs there is only one input species name for all the PM types. This variable has 3 dimensions, one for each PM type.
+                   IF (TRIM(emt_att%species_name(ind_inp))=="PM") THEN
+                      !>pm1
+                      IF (TRIM(spc_names(ind_mod))=="PM1") THEN
+                         len_index=len_index+1
+                      !>pm2.5
+                      ELSE IF (TRIM(spc_names(ind_mod))=="PM25") THEN
+                         len_index=len_index+1
+                      !>pm10
+                      ELSE IF (TRIM(spc_names(ind_mod))=="PM10") THEN
+                         len_index=len_index+1   
+                      ENDIF
+                   ENDIF
+
+                   !> NOx: for NOx by definition we have 2 splits. The Emission Input Name in this case is only one: NOx, while in the model we can have NO2 and NO    
+                   IF (TRIM(emt_att%species_name(ind_inp))=="NOx") THEN 
+                      !>no
+                      IF (TRIM(spc_names(ind_mod))=="NO") THEN
+                         len_index=len_index+1
+                      !>no2
+                      ELSE IF (TRIM(spc_names(ind_mod))=="NO2") THEN
+                         len_index=len_index+1                        
+                      ENDIF
+                   ENDIF
+
+                   !>SOX: same as for NOx, but with SO2 and SO4
+                   IF (TRIM(emt_att%species_name(ind_inp))=="SOx") THEN
+                      !>no
+                      IF (TRIM(spc_names(ind_mod))=="SO2") THEN
+                         len_index=len_index+1
+                      !>no2
+                      ELSE IF (TRIM(spc_names(ind_mod))=="SO4") THEN
+                         len_index=len_index+1                        
+                      ENDIF
+                   ENDIF
+
+                   !> Other Species
+                   IF (TRIM(emt_att%species_name(ind_inp))==TRIM(spc_names(ind_mod))) THEN
+                      len_index=len_index+1
+                   ENDIF
+                END DO   !> number of emission input species
+             END DO   !> number of model species
+
+
+             !> Allocate Arrays
+             IF (len_index>0) THEN
+
+                ALLOCATE(match_spec_input(len_index))
+                ALLOCATE(match_spec_model(len_index))
+
+                IF (len_index_voc>0) THEN
+                   ALLOCATE(match_spec_voc_model(len_index_voc))   !> contains indices of the VOC model species 
+                   ALLOCATE(match_spec_voc_input(len_index_voc))   !> In input there is only one value for VOCs in the DEFAULT mode. This array contains the indices of the different values of VOC compositions of the input variable VOC_composition
+                ENDIF
+
+                !> ASSIGN INDICES
+                !> Repeat the same cycles of above, but passing the species indices to the newly declared arrays
+                len_index=0
+                len_index_voc=0
+                
+                DO ind_mod = 1, SIZE(spc_names)
+                   DO ind_inp = 1, nspec_emis_inp 
+
+                      ! > VOCs
+                      IF ( TRIM(emt_att%species_name(ind_inp))=="VOC" .AND. ALLOCATED(match_spec_voc_input) ) THEN      
+                         DO ind_voc= 1,emt_att%nvoc
+                            IF (TRIM(emt_att%voc_name(ind_voc))==TRIM(spc_names(ind_mod))) THEN
+                               len_index=len_index+1
+                               len_index_voc=len_index_voc+1
+                        
+                               match_spec_input(len_index)=ind_inp
+                               match_spec_model(len_index)=ind_mod
+
+                               match_spec_voc_input(len_index_voc)=ind_voc
+                               match_spec_voc_model(len_index_voc)=ind_mod                         
+                            ENDIF
+                         END DO
+                      ENDIF
+
+                      !> PMs:In this case the Inputs have only PM while the model has three different possible types: PM1, PM2.5, PM10. We need an additional index for matching each PM index in the model. 
+                      IF (TRIM(emt_att%species_name(ind_inp))=="PM") THEN
+                         !>pm1
+                         IF (TRIM(spc_names(ind_mod))=="PM1") THEN
+                            len_index=len_index+1
+
+                            match_spec_input(len_index)=ind_inp
+                            match_spec_model(len_index)=ind_mod
+  
+                            !match_spec_pm(1)=ind_mod
+                         !>pm2.5
+                         ELSE IF (TRIM(spc_names(ind_mod))=="PM25") THEN
+                            len_index=len_index+1
+
+                            match_spec_input(len_index)=ind_inp
+                            match_spec_model(len_index)=ind_mod
+  
+                            !match_spec_pm(2)=ind_mod
+                         !>pm10
+                         ELSE IF (TRIM(spc_names(ind_mod))=="PM10") THEN
+                            len_index=len_index+1
+    
+                            match_spec_input(len_index)=ind_inp
+                            match_spec_model(len_index)=ind_mod
+  
+                            !match_spec_pm(3)=ind_mod
+                         ENDIF
+                      ENDIF
+
+                      !> NOx - The same as for PMs but here the model species are only 2: NO and NO2
+                      IF (TRIM(emt_att%species_name(ind_inp))=="NOx") THEN
+                         !>no
+                         IF (TRIM(spc_names(ind_mod))=="NO") THEN
+                            len_index=len_index+1
+
+                            match_spec_input(len_index)=ind_inp
+                            match_spec_model(len_index)=ind_mod
+  
+                            !match_spec_nox(1)=ind_mod
+                         !>no2
+                         ELSE IF (TRIM(spc_names(ind_mod))=="NO2") THEN
+                            len_index=len_index+1
+
+                            match_spec_input(len_index)=ind_inp
+                            match_spec_model(len_index)=ind_mod
+  
+                           ! match_spec_nox(2)=ind_mod
+                         ENDIF
+                      ENDIF
+
+                      !> SOx 
+                      IF (TRIM(emt_att%species_name(ind_inp))=="SOx") THEN
+                         !>so2
+                         IF (TRIM(spc_names(ind_mod))=="SO2") THEN
+                            len_index=len_index+1
+
+                            match_spec_input(len_index)=ind_inp
+                            match_spec_model(len_index)=ind_mod
+  
+                           ! match_spec_sox(1)=ind_mod
+                         !>so4
+                         ELSE IF (TRIM(spc_names(ind_mod))=="SO4") THEN
+                            len_index=len_index+1
+
+                            match_spec_input(len_index)=ind_inp
+                            match_spec_model(len_index)=ind_mod
+  
+                           ! match_spec_sox(2)=ind_mod
+                         ENDIF
+                      ENDIF
+
+                      !> Other Species
+                      IF (TRIM(emt_att%species_name(ind_inp))==TRIM(spc_names(ind_mod))) THEN
+                         len_index=len_index+1
+                            
+                         match_spec_input(len_index)=ind_inp
+                         match_spec_model(len_index)=ind_mod
+                      ENDIF
+                   END DO
+                END DO
+
+             ELSE
+
+                message_string = 'Given Chemistry Emission Species'            //          &
+                                 ' DO NOT MATCH'                                //          &
+                                 ' model chemical species'                      //          &
+                                 ' Chemistry Emissions routine is not called'         !TBD: IMPORTANT:Add a condition in chem init that sets the emission_output_required to false when len_index==0 so that the chem_emissions modules are not used
+                CALL message( 'chem_emissions_matching', 'CM0440', 0, 0, 0, 6, 0 ) 
+
+             ENDIF
+
+          ELSE
+
+             message_string = 'Array of Emission species not allocated: '            //          &
+                              ' Either no emission species are provided as input or'  //          &
+                              ' no chemical species are used by PALM:'                //          &
+                              ' Chemistry Emissions routine is not called'                                   
+             CALL message( 'chem_emissions_matching', 'CM0441', 0, 2, 0, 6, 0 ) 
+ 
+          ENDIF
+
+!-- CASE parameterized: In the parameterized case the user gives in input the exact species names of the chemical mechanism: no split is required for NOx, SOx, PMs and VOCs, but units of emissions inputs must be in (mole/m**)/s, made exception for PMs. 
+
+       CASE ("PARAMETERIZED")
+
+          len_index=0
+
+         !spc_names have to be greater than zero for proceeding
+          IF ( (SIZE(spc_names) .GT. 0) .AND. (nspec_emis_inp .GT. 0) ) THEN
+
+
+             !cycle over model species
+             DO ind_mod = 1, SIZE(spc_names)
+                ind_inp=1
+                DO  WHILE ( TRIM( surface_csflux_name( ind_inp ) ) /= 'novalue' )   !<'novalue' is the default  
+                   IF (TRIM(surface_csflux_name( ind_inp ))==TRIM(spc_names(ind_mod))) THEN
+                      len_index=len_index+1
+                   ENDIF
+                   ind_inp=ind_inp+1
+
+                ENDDO
+             ENDDO
+
+             !Proceed only if there are matched species
+             IF ( len_index .GT. 0 ) THEN
+
+                !Allocation of Arrays of the matched species
+                ALLOCATE(match_spec_input(len_index)) 
+ 
+                ALLOCATE(match_spec_model(len_index))
+
+                !Assign corresponding indices of input and model matched species
+                len_index=0
+
+                DO ind_mod = 1, SIZE(spc_names)  
+                   ind_inp = 1
+                   DO  WHILE ( TRIM( surface_csflux_name( ind_inp ) ) /= 'novalue' )   !<'novalue' is the default  
+                      IF (TRIM( surface_csflux_name( ind_inp ) ) == TRIM(spc_names(ind_mod)))           THEN
+                         len_index=len_index+1
+                         match_spec_input(len_index)=ind_inp
+                         match_spec_model(len_index)=ind_mod
+                      ENDIF
+                   ind_inp=ind_inp+1
+                   END DO
+                END DO
+
+                ! also, Add AN if to check that when the surface_csflux are passed to the namelist, also the street factor values are provided
+                DO  ispec = 1 , len_index
+
+                   IF ( emiss_factor_main(match_spec_input(ispec)) .LT. 0 .AND. emiss_factor_side(match_spec_input(ispec)) .LT. 0 ) THEN
+
+                      message_string = 'PARAMETERIZED emissions mode selected:'            //          &
+                                       ' EMISSIONS POSSIBLE ONLY ON STREET SURFACES'        //          &
+                                       ' but values of scaling factors for street types'    //          &
+                                       ' emiss_factor_main AND emiss_factor_side'           //          &
+                                       ' not provided for each of the emissions species'    //          &
+                                       ' or not provided at all: PLEASE set a finite value' //          &
+                                       ' for these parameters in the chemistry namelist'          
+                      CALL message( 'chem_emissions_matching', 'CM0442', 2, 2, 0, 6, 0 ) 
+                   ENDIF
+                END DO
+
+
+             ELSE
+                
+                message_string = 'Given Chemistry Emission Species'            //          &
+                                 ' DO NOT MATCH'                                //          &
+                                 ' model chemical species'                      //          &
+                                 ' Chemistry Emissions routine is not called'         
+                CALL message( 'chem_emissions_matching', 'CM0443', 0, 0, 0, 6, 0 ) 
+             ENDIF
+
+          ELSE
+     
+             message_string = 'Array of Emission species not allocated: '            //          &
+                              ' Either no emission species are provided as input or'  //          &
+                              ' no chemical species are used by PALM.'                //          &
+                              ' Chemistry Emissions routine is not called'                                   
+             CALL message( 'chem_emissions_matching', 'CM0444', 0, 2, 0, 6, 0 ) 
+ 
+          ENDIF             
+
+
+!-- CASE when emission module is switched on but mode_emis is not specified or it is given the wrong name
+       CASE DEFAULT
+
+          message_string = 'Chemistry Emissions Module switched ON, but'            //          &
+                           ' either no emission mode specified or incorrectly given :'  //          &
+                           ' please, pass the correct value to the namelist parameter "mode_emis"'                  
+          CALL message( 'chem_emissions_matching', 'CM0445', 2, 2, 0, 6, 0 )              
+
+       END SELECT
+
+END SUBROUTINE chem_emissions_match
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Initialization:
+!> Netcdf reading, arrays allocation and first calculation of cssws fluxes at timestep 0
+!>  
+!------------------------------------------------------------------------------!
+ SUBROUTINE chem_emissions_init(emt_att,emt,nspec_out)
+
+#if defined( __netcdf )
+
+    USE surface_mod,                                                           &
+       ONLY:  surf_lsm_h,surf_def_h,surf_usm_h
+    
+    IMPLICIT NONE
+ 
+    TYPE(chem_emis_att_type),INTENT(INOUT)                            :: emt_att   !> variable where to store all the information of 
+                                                                                   !  emission inputs whose values do not depend
+                                                                                   !  on the considered species
+
+    TYPE(chem_emis_val_type),INTENT(INOUT), ALLOCATABLE, DIMENSION(:) ::  emt      !> variable where to store emission inputs values, 
+                                                                                   !  depending on the considered species
+    
+    INTEGER(iwp),INTENT(INOUT)                                        :: nspec_out !> number of outputs of chemistry emission routines
+
+    CHARACTER (LEN=80)                                                :: units     !> units of chemistry inputs
+ 
+    INTEGER(iwp)                                                      :: ispec     !> Index to go through the emission chemical species
+
+
+!-- Actions for initial runs : TBD: needs to be updated
+  IF (  TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
+!--    ... 
+    
+!
+!-- Actions for restart runs
+  ELSE
+!--    ...
+
+  ENDIF
+
+
+  CALL location_message( 'Starting initialization of chemistry emissions arrays', .FALSE. )
+
+
+  !-- Match Input and Model emissions
+  CALL  chem_emissions_match(emt_att,nspec_out)
+
+  !> If nspec_out==0, then do not use emission module: The corresponding message is already printed in the matching routine 
+  IF ( nspec_out == 0 ) THEN
+  
+     emission_output_required=.FALSE.
+
+  ELSE
+
+     emission_output_required=.TRUE.
+
+
+!-----------------------------------------------------------------
+     !> Set molecule masses' 
+     ALLOCATE(emt_att%xm(nspec_out))
+     ! loop over emisisons:
+
+     DO ispec = 1, nspec_out
+       ! switch:
+        SELECT CASE ( TRIM(spc_names(match_spec_model(ispec))) )
+           CASE ( 'SO2','SO4' ) ; emt_att%xm(ispec) = xm_S + xm_O * 2      ! kg/mole
+           CASE ( 'NO','NO2' )  ; emt_att%xm(ispec) = xm_N + xm_O * 2      ! kg/mole  NO2 equivalent
+           CASE ( 'NH3' ) ; emt_att%xm(ispec) = xm_N + xm_H * 3  ! kg/mole
+           CASE ( 'CO'  ) ; emt_att%xm(ispec) = xm_C + xm_O      ! kg/mole
+           CASE ( 'CO2' ) ; emt_att%xm(ispec) = xm_C + xm_O * 2  ! kg/mole
+           CASE ( 'CH4' ) ; emt_att%xm(ispec) = xm_C + xm_H * 4  ! kg/mole     
+           CASE ( 'HNO3' ); emt_att%xm(ispec) = xm_H + xm_N + xm_O*3 !kg/mole  
+           CASE DEFAULT
+             !--  TBD: check if this hase to be removed
+              !emt_att%xm(ispec) = 1.0_wp
+        END SELECT
+     ENDDO
+
+    
+     !> ASSIGN EMISSION VALUES for the different emission modes
+     SELECT CASE(TRIM(mode_emis))   !TBD: Add the option for CApital or small letters 
+
+        !> Default case
+        CASE ("DEFAULT")
+
+           IF ( .NOT. ALLOCATED( emis_distribution) ) ALLOCATE( emis_distribution( 1, 0:ny, 0:nx, nspec_out ) ) 
+        
+           CALL location_message( 'emis_distribution array allocated in DEFAULT mode', .FALSE. )
+
+           !> Calculate the values of the emissions at the first time step
+           CALL chem_emissions_setup(emt_att,emt,nspec_out)
+
+
+        !> PRE-PROCESSED case
+        CASE ("PRE-PROCESSED")
+
+           IF ( .NOT. ALLOCATED( emis_distribution) ) ALLOCATE(emis_distribution(nzb:nzt+1,0:ny,0:nx,nspec_out))  
+
+           CALL location_message( 'emis_distribution array allocated in PRE-PROCESSED mode', .FALSE. )
+ 
+           !> Calculate the values of the emissions at the first time step
+           CALL chem_emissions_setup(emt_att,emt,nspec_out)
+
+        CASE ("PARAMETERIZED")
+
+           CALL location_message( 'emis_distribution array allocated in PARAMETERIZED mode', .FALSE. )
+
+           ! For now for PAR and DEF values only, first vertical level of emis_distribution is allocated, while for EXP all. 
+           IF ( .NOT. ALLOCATED( emis_distribution) ) ALLOCATE(emis_distribution(1,0:ny,0:nx,nspec_out))
+
+           !> Calculate the values of the emissions at the first time step
+           CALL chem_emissions_setup(emt_att,emt,nspec_out)
+
+     END SELECT
+
+  ENDIF    
+
+#endif
+
+
+ END SUBROUTINE chem_emissions_init
+
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Routine for Update of Emission values at each timestep 
+!-------------------------------------------------------------------------------!
+
+ SUBROUTINE chem_emissions_setup(emt_att,emt,nspec_out)
+
+   USE arrays_3d,                                                    &
+       ONLY:  dzw
+   USE grid_variables,                                                        &
+       ONLY: dx, dy
+   USE indices,                                                               &
+       ONLY: nnx,nny,nnz 
+   USE surface_mod,                                                           &
+       ONLY:  surf_lsm_h,surf_def_h,surf_usm_h
+   USE netcdf_data_input_mod,                                                 &
+       ONLY:  street_type_f
+   USE arrays_3d,                                                             &        
+       ONLY: hyp, pt 
+
+ IMPLICIT NONE
+
+#if defined( __netcdf )
+  
+    !--- IN/OUT
+
+    TYPE(chem_emis_att_type),INTENT(INOUT)                            ::  emt_att    !> variable where to store all the information of 
+                                                                                     !  emission inputs whose values do not depend
+                                                                                     !  on the considered species
+
+    TYPE(chem_emis_val_type),INTENT(INOUT), ALLOCATABLE, DIMENSION(:) ::  emt        !> variable where to store emission inputs values, 
+                                                                                     !  depending on the considered species
+
+    INTEGER,INTENT(IN)                                                ::  nspec_out  !> Output of routine chem_emis_matching with number
+                                                                                     !  of matched species
+    !---
+
+    REAL(wp),ALLOCATABLE,DIMENSION(:,:)                               ::  delta_emis !> Term to add to the emission_distribution array 
+                                                                                     !  for each of the categories at each time step 
+                                                                                     !  in the default mode
+
+    CHARACTER(LEN=80)                                                 ::  units      !> Units of the emissions
+
+    INTEGER(iwp)                                                      ::  icat       !> Index for number of categories
+    INTEGER(iwp)                                                      ::  ispec      !> index for number of species
+    INTEGER(iwp)                                                      ::  i_pm_comp  !> index for number of PM components
+    INTEGER(iwp)                                                      ::  ivoc       !> Index for number of components of  VOCs
+    INTEGER(iwp)                                                      ::  time_index !> Index for time
+    
+    REAL(wp),ALLOCATABLE, DIMENSION(:)                                ::  time_factor !> factor for time scaling of emissions
+    REAL(wp),ALLOCATABLE, DIMENSION(:,:)                              ::  emis
+
+    REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr)                    ::  conv_to_ratio !> factor used for converting input 
+                                                                                        !  to adimensional concentration ratio
+
+   ! ------------------------------------------
+    ! variables for the conversion of indices i and j according to surface_mod
+
+    INTEGER(iwp)                                                      ::  i          !> running index for grid in x-direction
+    INTEGER(iwp)                                                      ::  j          !> running index for grid in y-direction
+    INTEGER(iwp)                                                      ::  k          !> running index for grid in z-direction
+    INTEGER(iwp)                                                      ::  m          !> running index for horizontal surfaces
+
+    REAL(wp), DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr)                    ::  tmp_temp
+
+    ! --- const -------------------------------
+    !-CONVERSION FACTORS: TIME
+    ! number of hours in a year of 365 days:
+    REAL, PARAMETER  ::  hour_per_year = 8760.0 !> TBD: What about leap years?
+    ! conversion from hours to seconds (s/hour) = 1/3600.0 ~ 0.2777778   
+    REAL, PARAMETER   ::  hour_to_s = 0.0002777778  !  (hour)/(s)
+    ! conversion from day to seconds (s/day) = 1/86400.0 ~ 1.157407e-05   
+    REAL, PARAMETER   ::  day_to_s = 1.157407e-05   !  (day)/(s)
+    ! conversion from year to sec (s/year) = 1/31536000.0 ~ 3.170979e-08   
+    REAL, PARAMETER   ::  year_to_s = 3.170979e-08  !  (year)/(s)
+
+    !-CONVERSION FACTORS: WEIGHT
+    !  Conversion from tons to kg (kg/tons) = 100.0/1 ~ 100
+    REAL, PARAMETER   ::  tons_to_kg = 100  !  (tons)/(kg)
+    !  Conversion from g to kg (kg/g) = 1/1000.0 ~ 0.001
+    REAL, PARAMETER   ::  g_to_kg = 0.001  !  (g)/(kg)
+    !  Conversion from g to kg (kg/g) = 1/1000.0 ~ 0.001
+    REAL, PARAMETER   ::  miug_to_kg = 0.000000001  !  (microng)/(kg)
+
+    !< CONVERSION FACTORS: fraction to ppm
+    REAL(wp), PARAMETER   ::  ratio2ppm  = 1.0e06_wp  
+    !------------------------------------------------------    
+
+    IF ( emission_output_required ) THEN
+
+    !>  Set emis_dt  !TBD: this is the same as dt_chem. We should consider the fact that dt_emis should be the timestep of input emissions or better defined, the timestep at which the emission routines are calle: for now one hour. It should be made changeable.
+
+       IF ( call_chem_at_all_substeps )  THEN
+
+          dt_emis = dt_3d * weight_pres(intermediate_timestep_count)
+
+       ELSE
+
+          dt_emis = dt_3d
+
+       ENDIF
+
+
+    ! --- CHECK UNITS
+    !>-----------------------------------------------------
+    !> Conversion of the units to the ones employed in PALM. 
+    !> Possible temporal units of input emissions data are: year, hour and second; 
+    !> the mass could be expressed in: tons, kilograms or grams. 
+    !> IN the PARAMETERIZED mode no conversion is possible: in this case INPUTS have to have fixed units.
+    !>-----------------------------------------------------
+
+        IF (TRIM(mode_emis)=="DEFAULT" .OR. TRIM(mode_emis)=="PRE-PROCESSED" ) THEN
+
+          SELECT CASE(TRIM(emt_att%units))
+          !> kilograms
+             CASE ( 'kg/m2/s','KG/M2/S') 
+                CALL location_message( 'Units of the emissions are consistent with'  //          &
+                                       ' the ones employed in the PALM-4U model ', .FALSE. )
+                con_factor=1
+
+             CASE ('kg/m2/hour','KG/M2/HOUR')
+                CALL location_message( 'Units of emission inputs need conversion', .FALSE. )
+
+                con_factor=hour_to_s
+
+             CASE ( 'kg/m2/day','KG/M2/DAY' ) 
+                CALL location_message( 'Units of emission inputs need conversion', .FALSE. )
+
+                con_factor=day_to_s
+
+             CASE ( 'kg/m2/year','KG/M2/YEAR' )
+                CALL location_message( 'Units of emission inputs need conversion', .FALSE. )
+
+                con_factor=year_to_s
+
+          !> Tons
+             CASE ( 'ton/m2/s','TON/M2/S' ) 
+                CALL location_message( 'Units of emission inputs need conversion', .FALSE. )
+
+                con_factor=tons_to_kg
+
+             CASE ( 'ton/m2/hour','TON/M2/HOUR' ) 
+                CALL location_message( 'Units of emission inputs need conversion', .FALSE. )
+
+                con_factor=tons_to_kg*hour_to_s
+
+             CASE ( 'ton/m2/year','TON/M2/YEAR' ) 
+                CALL location_message( 'Units of emission inputs need conversion', .FALSE. )
+
+                con_factor=tons_to_kg*year_to_s
+
+          !> Grams
+             CASE ( 'g/m2/s','G/M2/S' )
+                CALL location_message( 'Units of emission inputs need conversion', .FALSE. )
+
+                con_factor=g_to_kg
+
+             CASE ( 'g/m2/hour','G/M2/HOUR' ) 
+                CALL location_message( 'Units of emission inputs need conversion', .FALSE. )
+
+                con_factor=g_to_kg*hour_to_s
+
+             CASE ( 'g/m2/year','G/M2/YEAR' )
+                CALL location_message( 'Units of emission inputs need conversion', .FALSE. )
+
+                con_factor=g_to_kg*year_to_s
+
+          !> Micro Grams
+             CASE ( 'micrograms/m2/s','MICROGRAMS/M2/S' )
+                CALL location_message( 'Units of emission inputs need conversion', .FALSE. )
+
+                con_factor=miug_to_kg
+
+             CASE ( 'micrograms/m2/hour','MICROGRAMS/M2/HOUR' ) 
+                CALL location_message( 'Units of emission inputs need conversion', .FALSE. )
+
+                con_factor=miug_to_kg*hour_to_s
+
+             CASE ( 'micrograms/m2/year','MICROGRAMS/M2/YEAR' )
+                CALL location_message( 'Units of emission inputs need conversion', .FALSE. )
+
+                con_factor=miug_to_kg*year_to_s
+
+             CASE DEFAULT  
+                message_string = 'The Units of the provided input chemistry emission species' // &
+                                 ' are not the ones required by PALM-4U: please check '      // &
+                                 ' chemistry emission module documentation.'                                 
+                CALL message( 'chem_emissions_setup', 'CM0446', 2, 2, 0, 6, 0 ) 
+
+                STOP
+          END SELECT
+
+         
+       !> PRE-PROCESSED and parameterized mode
+       ELSE 
+ 
+          message_string = 'No Units conversion required for units of chemistry emissions' // &
+                           ' of the PARAMETERIZED mode: units have to be provided in mole/m**2/s '
+          CALL message( 'chem_emissions_setup', 'CM0447', 0, 0, 0, 6, 0 ) 
+
+       ENDIF
+
+    !> Conversion factors (if the units are kg/m**2/s) we have to convert them to ppm/s
+     DO i=nxl,nxr
+          DO j=nys,nyn
+          !> Derive Temperature from Potential Temperature
+             tmp_temp(nzb:nzt+1,j,i) = pt(nzb:nzt+1,j,i) * ( hyp(nzb:nzt+1) * pref_i )**r_cp
+
+             !> We need to pass to cssws<- (ppm/s) * dz. 
+             !  Input is Nmole/(m^2*s)
+             !  To go to ppm*dz basically we need to multiply the input by (m**2/N)*dz
+             !  (m**2/N)*dz == V/N 
+             !  V/N=RT/P 
+
+             !>    m**3/Nmole             (J/mol)*K^-1           K                      Pa         
+             conv_to_ratio(nzb:nzt+1,j,i) = ( (Rgas * tmp_temp(nzb:nzt+1,j,i)) / ((hyp(nzb:nzt+1))) )  
+          ENDDO
+       ENDDO
+
+    !>------------------------------------------------
+    !> Start The Processing of the input data
+
+        emis_distribution(:,nys:nyn,nxl:nxr,:) = 0.0_wp
+
+    !>-----------------------------------------------
+    !> Distinguish between DEFAULT, PRE-PROCESSED and PARAMETERIZED mode when calculating time_factors: only done for DEFAULT mode. For the PARAMETERIZED mode there is a time factor but it is fixed in the model 
+  
+    !> PRE-PROCESSED MODE 
+       IF (TRIM(mode_emis)=="PRE-PROCESSED") THEN
+
+          CALL location_message( 'PRE-PROCESSED MODE: No time-factor specification required', .FALSE. )
+
+       ELSEIF (TRIM(mode_emis)=="DEFAULT") THEN
+
+          CALL location_message( 'DEFAULT MODE: time-factor specification required', .FALSE. )
+ 
+       !> Allocate array where to store temporary emission values      
+          IF(.NOT. ALLOCATED(emis)) ALLOCATE(emis(nys:nyn,nxl:nxr))
+
+       !> Allocate time factor per emitted component category
+          ALLOCATE(time_factor(emt_att%ncat))  
+
+       !> Read-in HOURLY emission time factor
+          IF (TRIM(time_fac_type)=="HOUR") THEN
+
+          !> Update time indices
+             CALL time_default_indices(month_of_year,day_of_month,hour_of_day,index_hh)
+
+          !> Check if the index is less or equal to the temporal dimension of HOURLY emission files              
+             IF (index_hh .LE. SIZE(emt_att%hourly_emis_time_factor(1,:))) THEN
+
+             !> Read-in the correspondant time factor              
+                time_factor(:)= emt_att%hourly_emis_time_factor(:,index_hh)      
+
+             ELSE
+
+                message_string = 'The "HOUR" time-factors (DEFAULT mode) of the chemistry emission species'           // &
+                              ' are not provided for each hour of the total simulation time'      
+                CALL message( 'chem_emissions_setup', 'CM0448', 2, 2, 0, 6, 0 ) 
+
+             ENDIF
+
+       !> Read-in MDH emissions time factors
+          ELSEIF (TRIM(time_fac_type)=="MDH") THEN
+
+          !> Update time indices      
+             CALL time_default_indices(daytype_mdh,month_of_year,day_of_month,hour_of_day,index_mm,index_dd,index_hh)
+
+
+          !> Check if the index is less or equal to the temporal dimension of MDH emission files              
+             IF ((index_hh+index_dd+index_mm) .LE. SIZE(emt_att%mdh_emis_time_factor(1,:))) THEN
+
+             !> Read-in the correspondant time factor              
+                time_factor(:)=emt_att%mdh_emis_time_factor(:,index_mm)*emt_att%mdh_emis_time_factor(:,index_dd)*   &
+                                                                         emt_att%mdh_emis_time_factor(:,index_hh)
+     
+             ELSE
+
+                message_string = 'The "MDH" time-factors (DEFAULT mode) of the chemistry emission species'           // &
+                              ' are not provided for each hour/day/month  of the total simulation time'      
+                CALL message( 'chem_emissions_setup', 'CM0449', 2, 2, 0, 6, 0 )
+
+             ENDIF 
+
+          ELSE
+          !> condition when someone used the DEFAULT mode but forgets to indicate the time-factor in the namelist
+             
+             message_string = 'The time-factor (DEFAULT mode) of the chemistry emission species'           // &
+                              ' is not provided in the NAMELIST'      
+             CALL message( 'chem_emissions_setup', 'CM0450', 2, 2, 0, 6, 0 )
+         
+          ENDIF
+
+       !> PARAMETERIZED MODE
+       ELSEIF (TRIM(mode_emis)=="PARAMETERIZED") THEN
+          CALL location_message( 'PARAMETERIZED MODE: time-factor specification is fixed: '                         // &
+                                 ' 24 values for every day of the year ', .FALSE. )
+        
+          !> in this case allocate time factor each hour in a day
+          IF (.NOT. ALLOCATED(time_factor)) ALLOCATE(time_factor(1))
+
+          !>Pass the values of time factors in the parameterized mode to the time_factor variable. in this case index_hh==hour_of_day
+          index_hh=hour_of_day
+
+          time_factor(1)=emt_att%par_emis_time_factor(index_hh)
+
+       ENDIF
+
+!--------------------------------
+!--  EMISSION DISTRIBUTION Calculation
+
+       !> PARAMETERIZED CASE
+       IF ( mode_emis == "PARAMETERIZED" ) THEN
+
+          DO ispec=1,nspec_out
+
+             !> Values are still micromoles/(m**2*s). Units are not given by the user for this mode and are always micromoles (or micrograms for PMs)
+             emis_distribution(1,nys:nyn,nxl:nxr,ispec)=surface_csflux(match_spec_input(ispec))*time_factor(1)
+
+          ENDDO 
+
+       !> PRE-PROCESSED CASE
+       ELSEIF (TRIM(mode_emis)=="PRE-PROCESSED") THEN
+
+          !> Start Cycle over Species
+          DO ispec=1,nspec_out !> nspec_out represents the number of species in common between 
+                               !  the emission input data and the chemistry mechanism used
+
+             emis_distribution(nzb:nzt+1,nys:nyn,nxl:nxr,ispec) = emt(match_spec_input(ispec))%                                  &
+                                                                      preproc_emission_data(index_hh,nzb:nzt+1,nys:nyn,nxl:nxr)* &
+                                                                   con_factor         
+
+          ENDDO
+
+      !TBD: At the moment the default mode considers a single vertical level (the surface). So we need to change it accordingly or eventually include the variable vertical_profile to be used in the default mode i we want to consider additional levels.
+
+       ELSE IF (TRIM(mode_emis)=="DEFAULT") THEN
+
+       !> Allocate array for the emission value corresponding to a specific category and time factor
+          ALLOCATE(delta_emis(nys:nyn,nxl:nxr))  
+
+
+       !> Start Cycle over categories
+          DO icat = 1, emt_att%ncat
+ 
+          !> Start Cycle over Species
+             DO ispec=1,nspec_out !> nspec_out represents the number of species in common between 
+                                  !  the emission input data and the chemistry mechanism used
+
+                emis(nys:nyn,nxl:nxr) = emt(match_spec_input(ispec))%default_emission_data(icat,nys+1:nyn+1,nxl+1:nxr+1)
+
+!TBD: The consideration of dt_emis of the input data is still missing. Basically the emissions could be provided every 10, 30 minutes and not always at one hour. This should be eventually solved in the date_and_time mode routine.
+
+             !> NOX Compositions
+                IF (TRIM(spc_names(match_spec_model(ispec)))=="NO") THEN
+                !>             Kg/m2                       kg/m2*s                                                    
+                   delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr)*time_factor(icat)*emt_att%nox_comp(icat,1)*con_factor
+                   
+                   emis_distribution(1,nys:nyn,nxl:nxr,ispec)=emis_distribution(1,nys:nyn,nxl:nxr,ispec)+delta_emis(nys:nyn,nxl:nxr)
+
+                ELSE IF (TRIM(spc_names(match_spec_model(ispec)))=="NO2") THEN
+   
+                   delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr)*time_factor(icat)*emt_att%nox_comp(icat,2)*con_factor
+
+                   emis_distribution(1,nys:nyn,nxl:nxr,ispec)=emis_distribution(1,nys:nyn,nxl:nxr,ispec)+delta_emis(nys:nyn,nxl:nxr)
+ 
+             !> SOX Compositions
+                      
+                ELSE IF (TRIM(spc_names(match_spec_model(ispec)))=="SO2") THEN
+                      
+                   delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr)*time_factor(icat)*emt_att%sox_comp(icat,1)*con_factor
+
+                   emis_distribution(1,nys:nyn,nxl:nxr,ispec)=emis_distribution(1,nys:nyn,nxl:nxr,ispec)+delta_emis(nys:nyn,nxl:nxr)
+
+                ELSE IF (TRIM(spc_names(match_spec_model(ispec)))=="SO4") THEN
+   
+                   delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr)*time_factor(icat)*emt_att%sox_comp(icat,2)*con_factor
+
+                   emis_distribution(1,nys:nyn,nxl:nxr,ispec)=emis_distribution(1,nys:nyn,nxl:nxr,ispec)+delta_emis(nys:nyn,nxl:nxr)
+ 
+
+             !> PMs should be in kg/m**2/s, so conversion factor is here still required
+             !> PM1 Compositions
+                ELSE IF (TRIM(spc_names(match_spec_model(ispec)))=="PM1") THEN
+
+                !> Cycle over the different pm components for PM1 type
+                   DO i_pm_comp= 1,SIZE(emt_att%pm_comp(1,:,1))
+
+                      delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr)*time_factor(icat)*emt_att%pm_comp(icat,i_pm_comp,1)*con_factor 
+                                                                                         
+
+                      emis_distribution(1,nys:nyn,nxl:nxr,ispec)=emis_distribution(1,nys:nyn,nxl:nxr,ispec)+delta_emis(nys:nyn,nxl:nxr)
+ 
+                   ENDDO
+
+             !> PM2.5 Compositions
+                ELSE IF (TRIM(spc_names(match_spec_model(ispec)))=="PM25") THEN
+
+                !> Cycle over the different pm components for PM2.5 type
+                   DO i_pm_comp= 1,SIZE(emt_att%pm_comp(1,:,2))
+
+                      delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr)*time_factor(icat)*emt_att%pm_comp(icat,i_pm_comp,2)*con_factor 
+                                                                                         
+
+                      emis_distribution(1,nys:nyn,nxl:nxr,ispec)=emis_distribution(1,nys:nyn,nxl:nxr,ispec)+delta_emis(nys:nyn,nxl:nxr)
+ 
+                   ENDDO
+
+             !> PM10 Compositions
+                ELSE IF (TRIM(spc_names(match_spec_model(ispec)))=="PM10") THEN
+
+                !> Cycle over the different pm components for PM10 type
+                   DO i_pm_comp= 1,SIZE(emt_att%pm_comp(1,:,3))  
+                       
+                      delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr)*time_factor(icat)*emt_att%pm_comp(icat,i_pm_comp,3)*con_factor 
+                                                                                                 
+
+                      emis_distribution(1,nys:nyn,nxl:nxr,ispec)=emis_distribution(1,nys:nyn,nxl:nxr,ispec)+delta_emis(nys:nyn,nxl:nxr) 
+
+                   ENDDO
+
+             !> VOCs Compositions: for VOCs, the input value is provided in kg/m**2*s but the composition is provided in mole/kg: a conversion factor for the input that could be eventually provided in, for example, tons/(m**2*s) is still required
+                ELSE IF  (SIZE(match_spec_voc_input) .GT. 0) THEN
+
+                  !TBD: maybe we can avoid the cycle 
+                   DO ivoc= 1,SIZE(match_spec_voc_input)
+
+                      IF (TRIM(spc_names(match_spec_model(ispec)))==TRIM(emt_att%voc_name(ivoc))) THEN    
+
+                         delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr)*time_factor(icat)*                               &
+                                                       emt_att%voc_comp(icat,match_spec_voc_input(ivoc))*con_factor
+
+                         emis_distribution(1,nys:nyn,nxl:nxr,ispec)=emis_distribution(1,nys:nyn,nxl:nxr,ispec)+delta_emis(nys:nyn,nxl:nxr) 
+
+                      ENDIF                       
+
+                   ENDDO
+                
+             !> General case (other species)
+                ELSE
+
+                   delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr)*time_factor(icat)*con_factor
+ 
+                   emis_distribution(1,nys:nyn,nxl:nxr,ispec)=emis_distribution(1,nys:nyn,nxl:nxr,ispec)+delta_emis(nys:nyn,nxl:nxr) 
+
+                ENDIF  ! IF (spc_names==)
+
+                !> for every species and category set emis to 0 so to avoid overwriting. TBD: discuss whether necessary
+
+                emis(:,:)= 0 
+
+             ENDDO
+
+          !> for every category set delta_emis to 0 so to avoid overwriting. TBD: discuss whether necessary
+
+          delta_emis(:,:)=0 
+ 
+          ENDDO
+
+       ENDIF  !> mode_emis
+
+!-------------------------------------------------------------------------------------------------------
+!--- Cycle to transform x,y coordinates to the one of surface_mod and to assign emission values to cssws
+!-------------------------------------------------------------------------------------------------------
+
+!-- PARAMETERIZED mode
+       !> For the PARAMETERIZED mode units of inputs are always micromoles/(m**2*s). In this case we do not need the molar mass for conversion into ppms
+       IF (TRIM(mode_emis)=="PARAMETERIZED") THEN
+
+          IF ( street_type_f%from_file )  THEN
+
+       !> Streets are lsm surfaces, hence, no usm surface treatment required
+             IF (surf_lsm_h%ns .GT. 0) THEN
+                DO  m = 1, surf_lsm_h%ns
+                   i = surf_lsm_h%i(m)
+                   j = surf_lsm_h%j(m)
+                   k = surf_lsm_h%k(m)
+
+
+                   IF ( street_type_f%var(j,i) >= main_street_id  .AND. street_type_f%var(j,i) < max_street_id )  THEN
+
+                   !> Cycle over already matched species
+                      DO  ispec=1,nspec_out
+
+                         !> PMs are already in mass units:micrograms:they have to be converted to kilograms 
+                         IF (TRIM(spc_names(match_spec_model(ispec)))=="PM1" .OR. TRIM(spc_names(match_spec_model(ispec)))=="PM25"  &
+                             .OR. TRIM(spc_names(match_spec_model(ispec)))=="PM10") THEN
+
+                            !              kg/(m^2*s) *kg/m^3                                
+                            surf_lsm_h%cssws(match_spec_model(ispec),m) = emiss_factor_main(match_spec_input(ispec)) * &
+                            !                                                       kg/(m^2*s)
+                                                                                emis_distribution(1,j,i,ispec)*        &
+                            !                                                    kg/m^3
+                                                                                rho_air(k)   
+
+                         ELSE
+
+                         !> Other Species: inputs are micromoles: they have to be converted in moles
+                         !                 ppm/s *m *kg/m^3                
+                            surf_lsm_h%cssws(match_spec_model(ispec),m) = emiss_factor_main(match_spec_input(ispec))*   &
+                         !                                                    micromoles/(m^2*s)
+                                                                          emis_distribution(1,j,i,ispec) *              &
+                         !                                                    m**3/Nmole
+                                                                          conv_to_ratio(k,j,i)*                         &       
+                         !                                                    kg/m^3
+                                                                          rho_air(k)   
+ 
+
+                         ENDIF
+
+                      ENDDO
+
+
+                   ELSEIF ( street_type_f%var(j,i) >= side_street_id  .AND. street_type_f%var(j,i) < main_street_id )  THEN
+
+                   !> Cycle over already matched species
+                      DO  ispec=1,nspec_out
+
+                         !> PMs are already in mass units: micrograms
+                         IF (TRIM(spc_names(match_spec_model(ispec)))=="PM1" .OR. TRIM(spc_names(match_spec_model(ispec)))=="PM25"  &
+                             .OR. TRIM(spc_names(match_spec_model(ispec)))=="PM10") THEN
+
+                            !              kg/(m^2*s) *kg/m^3                               
+                            surf_lsm_h%cssws(match_spec_model(ispec),m)= emiss_factor_side(match_spec_input(ispec)) *   &
+                            !                                                       kg/(m^2*s)
+                                                                                emis_distribution(1,j,i,ispec)*        &
+                            !                                                    kg/m^3
+                                                                                rho_air(k)   
+                         ELSE
+                       
+
+                         !>Other Species: inputs are micromoles
+                         !                 ppm/s *m *kg/m^3                
+                            surf_lsm_h%cssws(match_spec_model(ispec),m) = emiss_factor_side(match_spec_input(ispec)) *   &
+                         !                                                    micromoles/(m^2*s)
+                                                                          emis_distribution(1,j,i,ispec) *              &
+                         !                                                    m**3/Nmole
+                                                                          conv_to_ratio(k,j,i)*                         &       
+                         !                                                    kg/m^3
+                                                                          rho_air(k)   
+                         ENDIF
+
+                      ENDDO
+
+                   ELSE
+
+                   !> If no street type is defined, then assign null emissions to all the species
+                      surf_lsm_h%cssws(:,m) = 0.0_wp
+
+                   ENDIF
+
+                ENDDO
+
+             ENDIF
+
+          ENDIF
+
+       !> For both DEFAULT and PRE-PROCESSED
+       ELSE    
+       
+
+          DO ispec=1,nspec_out 
+                                !TBD: for the PRE-PROCESSED mode in the future, values at different heights should be included!            
+             !> Default surface type
+             IF (surf_def_h(0)%ns .GT. 0) THEN
+
+                DO  m = 1, surf_def_h(0)%ns
+
+                   i = surf_def_h(0)%i(m)
+                   j = surf_def_h(0)%j(m)
+
+                   !> Distinguish between PMs (no needing conversion in ppms), 
+                   !  VOC (already converted to moles/(m**2*s) using conv_factors: they do not need molar masses for their conversion to PPMs ) and
+                   ! other Species (still expressed in Kg/(m**2*s) at this point)
+
+                   !> PMs
+                   IF (TRIM(spc_names(match_spec_model(ispec)))=="PM1" .OR. TRIM(spc_names(match_spec_model(ispec)))=="PM25"  &
+                          .OR. TRIM(spc_names(match_spec_model(ispec)))=="PM10") THEN
+                   
+                      !            kg/(m^2*s) *kg/m^3                         kg/(m^2*s)                 
+                      surf_def_h(0)%cssws(match_spec_model(ispec),m) = emis_distribution(1,j,i,ispec)*   &
+                      !                                                  kg/m^3
+                                                                       rho_air(k)   
+ 
+ 
+                   ELSE
+
+                      !> VOCs
+                      IF ( len_index_voc .GT. 0 .AND. emt_att%species_name(match_spec_input(ispec))=="VOC" ) THEN
+                         !          ( ppm/s) * m * kg/m^3                         mole/(m**2/s)   
+                         surf_def_h(0)%cssws(match_spec_model(ispec),m) = emis_distribution(1,j,i,ispec) *      &
+                                                                         !    m**3/mole          ppm
+                                                                          conv_to_ratio(k,j,i)*ratio2ppm *      &
+                      !                                                    kg/m^3
+                                                                          rho_air(k)   
+
+
+                      !> OTHER SPECIES
+                      ELSE
+
+                         !               ( ppm/s )*m  * kg/m^3                      kg/(m**2/s)                      
+                         surf_def_h(0)%cssws(match_spec_model(ispec),m) = emis_distribution(1,j,i,ispec) *      &
+                                                                            !  mole/Kg        
+                                                                          (1/emt_att%xm(ispec))*                &
+                         !                                                    m**3/mole          ppm
+                                                                          conv_to_ratio(k,j,i)*ratio2ppm*       &
+                         !                                                  kg/m^3
+                                                                          rho_air(k)   
+  
+
+                      ENDIF
+
+                   ENDIF
+
+                ENDDO
+
+             END IF
+         
+             !-- Land Surface Mode surface type
+             IF (surf_lsm_h%ns .GT. 0) THEN
+
+                DO m = 1, surf_lsm_h%ns
+
+                   i = surf_lsm_h%i(m)
+                   j = surf_lsm_h%j(m)
+                   k = surf_lsm_h%k(m)
+
+                   !> Distinguish between PMs (no needing conversion in ppms), 
+                   !  VOC (already converted to moles/(m**2*s) using conv_factors: they do not need molar masses for their conversion to PPMs ) and
+                   ! other Species (still expressed in Kg/(m**2*s) at this point)
+
+                   !> PMs
+                   IF (TRIM(spc_names(match_spec_model(ispec)))=="PM1" .OR. TRIM(spc_names(match_spec_model(ispec)))=="PM25"  &
+                          .OR. TRIM(spc_names(match_spec_model(ispec)))=="PM10") THEN
+
+                      !         kg/(m^2*s) * kg/m^3                           kg/(m^2*s)            
+                      surf_lsm_h%cssws(match_spec_model(ispec),m) = emis_distribution(1,j,i,ispec) *              &
+                      !                                                  kg/m^3
+                                                                       rho_air(k)   
+ 
+                   ELSE
+
+                      !> VOCs
+                      IF ( len_index_voc .GT. 0 .AND. emt_att%species_name(match_spec_input(ispec))=="VOC" ) THEN
+                         !          ( ppm/s) * m * kg/m^3                        mole/(m**2/s)   
+                         surf_lsm_h%cssws(match_spec_model(ispec),m) = emis_distribution(1,j,i,ispec) *      &
+                                                                       !    m**3/mole          ppm
+                                                                       conv_to_ratio(k,j,i)*ratio2ppm*    &
+                      !                                                 kg/m^3
+                                                                       rho_air(k)   
+
+
+                      !> OTHER SPECIES
+                      ELSE
+
+                         !         ( ppm/s) * m * kg/m^3                        kg/(m**2/s)                      
+                         surf_lsm_h%cssws(match_spec_model(ispec),m) = emis_distribution(1,j,i,ispec) *               &
+                                                                            !  mole/Kg    
+                                                                      (1/emt_att%xm(ispec))*                          &
+                         !                                                m**3/mole           ppm
+                                                                      conv_to_ratio(k,j,i)*ratio2ppm*                 &
+                         !                                            kg/m^3
+                                                                      rho_air(k)   
+                                                      
+                      ENDIF
+
+                   ENDIF
+                ENDDO
+
+             END IF
+
+             !-- Urban Surface Mode surface type
+             IF (surf_usm_h%ns .GT. 0) THEN
+
+
+                DO m = 1, surf_usm_h%ns
+
+                   i = surf_usm_h%i(m)
+                   j = surf_usm_h%j(m)
+                   k = surf_usm_h%k(m)
+
+
+                   !> PMs
+                   IF (TRIM(spc_names(match_spec_model(ispec)))=="PM1" .OR. TRIM(spc_names(match_spec_model(ispec)))=="PM25"  &
+                          .OR. TRIM(spc_names(match_spec_model(ispec)))=="PM10") THEN
+                   
+                      !          kg/(m^2*s) *kg/m^3                             kg/(m^2*s)                     
+                      surf_usm_h%cssws(match_spec_model(ispec),m) = emis_distribution(1,j,i,ispec)*        & 
+                      !                                              kg/m^3
+                                                                    rho_air(k)   
+
+ 
+                   ELSE
+
+                      !> VOCs
+                      IF ( len_index_voc .GT. 0 .AND. emt_att%species_name(match_spec_input(ispec))=="VOC" ) THEN
+                         !          ( ppm/s) * m * kg/m^3                        mole/(m**2/s)   
+                         surf_usm_h%cssws(match_spec_model(ispec),m) = emis_distribution(1,j,i,ispec) *   &
+                                                                       !    m**3/mole          ppm
+                                                                       conv_to_ratio(k,j,i)*ratio2ppm*    &
+                      !                                                kg/m^3
+                                                                       rho_air(k)   
+
+                      !> OTHER SPECIES
+                      ELSE
+
+
+                      !            ( ppm/s) * m * kg/m^3                        kg/(m**2/s)                      
+                         surf_usm_h%cssws(match_spec_model(ispec),m) = emis_distribution(1,j,i,ispec) *      &
+                                                                          !  mole/Kg    
+                                                                      (1/emt_att%xm(ispec))*                 &
+                         !                                                m**3/mole           ppm
+                                                                      conv_to_ratio(k,j,i)*ratio2ppm*        &
+                         !                                            kg/m^3
+                                                                      rho_air(k)   
+
+
+                      ENDIF
+
+                   ENDIF
+ 
+                ENDDO
+             END IF
+          ENDDO
+
+       ENDIF 
+
+
+    !> At the end of each call to chem_emissions setup, the time_factor is deallocated (ALLOCATED ONLY in the DEFAULT mode) 
+
+       IF ( ALLOCATED ( time_factor ) ) DEALLOCATE( time_factor )
+
+   ENDIF !> emis_output_required
+
+
+#endif
+
+ END SUBROUTINE chem_emissions_setup
+
+ END MODULE chem_emissions_mod
Index: palm/trunk/SOURCE/chem_gasphase_mod.f90
===================================================================
--- palm/trunk/SOURCE/chem_gasphase_mod.f90	(revision 3297)
+++ palm/trunk/SOURCE/chem_gasphase_mod.f90	(revision 3298)
@@ -1,8 +1,28 @@
 MODULE chem_gasphase_mod
+ 
+!   Mechanism: passive
+!
 !------------------------------------------------------------------------------!
 !
 ! ******Module chem_gasphase_mod is automatically generated by kpp4palm ******
 !
-!           *********Please do NOT change this Code *********
+!   *********Please do NOT change this Code,it will be ovewritten *********
+!
+!------------------------------------------------------------------------------!
+! This file was created by KPP (http://people.cs.vt.edu/asandu/Software/Kpp/)
+! and kpp4palm (created by Klaus Ketelsen). kpp4palm is an adapted version 
+! of KP4 (JÃ¶ckel,P.,Kerkweg,A.,Pozzer,A.,Sander,R.,Tost,H.,Riede,
+! H.,Baumgaertner,A.,Gromov,S.,and Kern,B.,2010: Development cycle 2 of
+! the Modular Earth Submodel System (MESSy2),Geosci. Model Dev.,3,717-752,
+! https://doi.org/10.5194/gmd-3-717-2010). KP4 is part of the Modular Earth 
+! Submodel System (MESSy),which is is available under the  GNU General Public 
+! License (GPL).
+!
+! KPP is free software; you can redistribute it and/or modify it under the terms 
+! of the General Public Licence as published by the Free Software Foundation; 
+! either version 2 of the License,or (at your option) any later version. 
+! KPP is distributed in the hope that it will be useful,but WITHOUT ANY WARRANTY; 
+! without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 
+! PURPOSE. See the GNU General Public Licence for more details. 
 !
 !------------------------------------------------------------------------------!
@@ -11,13 +31,13 @@
 ! PALM is free software: you can redistribute it and/or modify it under the
 ! terms of the GNU General Public License as published by the Free Software
-! Foundation, either version 3 of the License, or (at your option) any later
+! Foundation,either version 3 of the License,or (at your option) any later
 ! version.
 !
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! PALM is distributed in the hope that it will be useful,but WITHOUT ANY
 ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
 ! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
 !
 ! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
+! PALM. If not,see <http://www.gnu.org/licenses/>.
 !
 ! Copyright 1997-2018 Leibniz Universitaet Hannover
@@ -30,14 +50,12 @@
 ! Former revisions:
 ! -----------------
-! $Id: module_header 2460 2017-09-13 14:47:48Z forkel $
-! Removed preprocessor directive __chem
-! 
-! 2460 2017-09-13 14:47:48Z forkel
-!
-! 
-! Variables for photolyis added
-!
-!
-!
+! $Id: chem_gasphase_mod.f90 3287 2018-09-28 10:19:58Z forkel $
+! forkel June 2018: qvap,fakt added
+! forkel June 2018: reset case in  Initialize,Integrate,Update_rconst
+! 
+! 
+! 3287 2018-09-28 10:19:58Z forkel
+!
+! forkel Sept. 2017: Variables for photolyis added
 !
 !
@@ -52,9 +70,9 @@
   USE kinds,           ONLY: dp=>wp
 
-  USE pegrid,          ONLY: myid,threads_per_task
+  USE pegrid,          ONLY: myid, threads_per_task
 
   IMPLICIT        NONE
   PRIVATE
-  !SAVE  ! NOTE: OCCURS AGAIN IN AUTOMATICALLY GENERATED CODE ...
+  !SAVE  ! note: occurs again in automatically generated code ...
 
 !  PUBLIC :: IERR_NAMES
@@ -63,15 +81,18 @@
 !         ,REQ_MCFCT,IP_MAX,jname
 
-  PUBLIC :: eqn_names, phot_names,spc_names
+  PUBLIC :: eqn_names, phot_names, spc_names
   PUBLIC :: nmaxfixsteps
-  PUBLIC :: atol,rtol
-  PUBLIC :: nspec,nreact
+  PUBLIC :: atol, rtol
+  PUBLIC :: nspec, nreact
   PUBLIC :: temp
+  PUBLIC :: qvap
+  PUBLIC :: fakt
   PUBLIC :: phot 
   PUBLIC :: rconst
   PUBLIC :: nvar
   PUBLIC :: nphot
- 
-  PUBLIC :: initialize,integrate,update_rconst
+  PUBLIC :: vl_dim                     ! PUBLIC to ebable other MODULEs to distiguish between scalar and vec
+ 
+  PUBLIC :: initialize, integrate, update_rconst
   PUBLIC :: chem_gasphase_integrate
   PUBLIC :: initialize_kpp_ctrl
@@ -82,14 +103,15 @@
                                                                  
   LOGICAL, PARAMETER          :: l_vector = .FALSE.            
-  INTEGER, PARAMETER          :: i_lu_di = 0
+  INTEGER, PARAMETER          :: i_lu_di = 2
   INTEGER, PARAMETER          :: vl_dim = 1
   INTEGER                     :: vl                              
                                                                  
   INTEGER                     :: vl_glo                          
-  INTEGER                     :: is,ie                           
+  INTEGER                     :: is, ie                           
                                                                  
-  INTEGER, DIMENSION(vl_dim)  :: kacc,krej                      
+                                                                 
+  INTEGER, DIMENSION(vl_dim)  :: kacc, krej                       
   INTEGER, DIMENSION(vl_dim)  :: ierrv                           
-  LOGICAL                     :: data_loaded = .false.             
+  LOGICAL                     :: data_loaded = .FALSE.             
 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ! 
@@ -107,6 +129,6 @@
 ! 
 ! File                 : chem_gasphase_mod_Parameters.f90
-! Time                 : Fri Dec  8 11:54:15 2017
-! Working directory    : /home/forkel-r/palmstuff/work/chemistry20171117/GASPHASE_PREPROC/tmp_kpp4palm
+! Time                 : Tue Sep 25 18:34:57 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
 ! Equation file        : chem_gasphase_mod.kpp
 ! Output root filename : chem_gasphase_mod
@@ -120,39 +142,35 @@
 
 ! NSPEC - Number of chemical species
-  INTEGER,PARAMETER :: nspec = 2 
+  INTEGER, PARAMETER :: nspec = 2 
 ! NVAR - Number of Variable species
-  INTEGER,PARAMETER :: nvar = 2 
+  INTEGER, PARAMETER :: nvar = 2 
 ! NVARACT - Number of Active species
-  INTEGER,PARAMETER :: nvaract = 2 
+  INTEGER, PARAMETER :: nvaract = 2 
 ! NFIX - Number of Fixed species
-  INTEGER,PARAMETER :: nfix = 1 
+  INTEGER, PARAMETER :: nfix = 1 
 ! NREACT - Number of reactions
-  INTEGER,PARAMETER :: nreact = 2 
+  INTEGER, PARAMETER :: nreact = 2 
 ! NVARST - Starting of variables in conc. vect.
-  INTEGER,PARAMETER :: nvarst = 1 
+  INTEGER, PARAMETER :: nvarst = 1 
 ! NFIXST - Starting of fixed in conc. vect.
-  INTEGER,PARAMETER :: nfixst = 3 
+  INTEGER, PARAMETER :: nfixst = 3 
 ! NONZERO - Number of nonzero entries in Jacobian
-  INTEGER,PARAMETER :: nonzero = 2 
+  INTEGER, PARAMETER :: nonzero = 2 
 ! LU_NONZERO - Number of nonzero entries in LU factoriz. of Jacobian
-  INTEGER,PARAMETER :: lu_nonzero = 2 
+  INTEGER, PARAMETER :: lu_nonzero = 2 
 ! CNVAR - (NVAR+1) Number of elements in compressed row format
-  INTEGER,PARAMETER :: cnvar = 3 
+  INTEGER, PARAMETER :: cnvar = 3 
 ! CNEQN - (NREACT+1) Number stoicm elements in compressed col format
-  INTEGER,PARAMETER :: cneqn = 3 
+  INTEGER, PARAMETER :: cneqn = 3 
 ! NHESS - Length of Sparse Hessian
-  INTEGER,PARAMETER :: nhess = 1 
-! NLOOKAT - Number of species to look at
-  INTEGER,PARAMETER :: nlookat = 0 
-! NMONITOR - Number of species to monitor
-  INTEGER,PARAMETER :: nmonitor = 0 
+  INTEGER, PARAMETER :: nhess = 1 
 ! NMASS - Number of atoms to check mass balance
-  INTEGER,PARAMETER :: nmass = 1 
+  INTEGER, PARAMETER :: nmass = 1 
 
 ! Index declaration for variable species in C and VAR
 !   VAR(ind_spc) = C(ind_spc)
 
-  INTEGER,PARAMETER,PUBLIC :: ind_pm10 = 1 
-  INTEGER,PARAMETER,PUBLIC :: ind_pm25 = 2 
+  INTEGER, PARAMETER, PUBLIC :: ind_pm10 = 1 
+  INTEGER, PARAMETER, PUBLIC :: ind_pm25 = 2 
 
 ! Index declaration for fixed species in C
@@ -165,8 +183,8 @@
 
 ! NJVRP - Length of sparse Jacobian JVRP
-  INTEGER,PARAMETER :: njvrp = 2 
+  INTEGER, PARAMETER :: njvrp = 2 
 
 ! NSTOICM - Length of Sparse Stoichiometric Matrix
-  INTEGER,PARAMETER :: nstoicm = 1 
+  INTEGER, PARAMETER :: nstoicm = 1 
 
 
@@ -186,6 +204,6 @@
 ! 
 ! File                 : chem_gasphase_mod_Global.f90
-! Time                 : Fri Dec  8 11:54:15 2017
-! Working directory    : /home/forkel-r/palmstuff/work/chemistry20171117/GASPHASE_PREPROC/tmp_kpp4palm
+! Time                 : Tue Sep 25 18:34:57 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
 ! Equation file        : chem_gasphase_mod.kpp
 ! Output root filename : chem_gasphase_mod
@@ -207,21 +225,13 @@
   REAL(kind=dp):: fix(nfix)
 ! VAR,FIX are chunks of array C
-      equivalence( c(1),var(1))
+      EQUIVALENCE( c(1), var(1))
 ! RCONST - Rate constants (global)
   REAL(kind=dp):: rconst(nreact)
 ! TIME - Current integration time
   REAL(kind=dp):: time
-! SUN - Sunlight intensity between [0,1]
-  REAL(kind=dp):: sun
 ! TEMP - Temperature
-  REAL(dp),dimension(:),allocatable             :: temp
-! RTOLS - (scalar) Relative tolerance
-  REAL(kind=dp):: rtols
+  REAL(kind=dp):: temp
 ! TSTART - Integration start time
   REAL(kind=dp):: tstart
-! TEND - Integration end time
-  REAL(kind=dp):: tend
-! DT - Integration step
-  REAL(kind=dp):: dt
 ! ATOL - Absolute tolerance
   REAL(kind=dp):: atol(nvar)
@@ -230,14 +240,14 @@
 ! STEPMIN - Lower bound for integration step
   REAL(kind=dp):: stepmin
-! STEPMAX - Upper bound for integration step
-  REAL(kind=dp):: stepmax
 ! CFACTOR - Conversion factor for concentration units
   REAL(kind=dp):: cfactor
-! DDMTYPE - DDM sensitivity w.r.t.: 0=init.val.,1=params
-  INTEGER :: ddmtype
 
 ! INLINED global variable declarations
 
-  !   declaration of global variable declarations for photolysis will come from 
+! QVAP - Water vapor
+  REAL(kind=dp):: qvap
+! FAKT - Conversion factor
+  REAL(kind=dp):: fakt
+
 
 ! INLINED global variable declarations
@@ -260,6 +270,6 @@
 ! 
 ! File                 : chem_gasphase_mod_JacobianSP.f90
-! Time                 : Fri Dec  8 11:54:15 2017
-! Working directory    : /home/forkel-r/palmstuff/work/chemistry20171117/GASPHASE_PREPROC/tmp_kpp4palm
+! Time                 : Tue Sep 25 18:34:57 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
 ! Equation file        : chem_gasphase_mod.kpp
 ! Output root filename : chem_gasphase_mod
@@ -275,14 +285,14 @@
 
 
-  INTEGER,PARAMETER,DIMENSION(2):: lu_irow =  (/ &
+  INTEGER, PARAMETER, DIMENSION(2):: lu_irow =  (/ &
        1, 2 /) 
 
-  INTEGER,PARAMETER,DIMENSION(2):: lu_icol =  (/ &
+  INTEGER, PARAMETER, DIMENSION(2):: lu_icol =  (/ &
        1, 2 /) 
 
-  INTEGER,PARAMETER,DIMENSION(3):: lu_crow =  (/ &
+  INTEGER, PARAMETER, DIMENSION(3):: lu_crow =  (/ &
        1, 2, 3 /) 
 
-  INTEGER,PARAMETER,DIMENSION(3):: lu_diag =  (/ &
+  INTEGER, PARAMETER, DIMENSION(3):: lu_diag =  (/ &
        1, 2, 3 /) 
 
@@ -304,6 +314,6 @@
 ! 
 ! File                 : chem_gasphase_mod_Monitor.f90
-! Time                 : Fri Dec  8 11:54:15 2017
-! Working directory    : /home/forkel-r/palmstuff/work/chemistry20171117/GASPHASE_PREPROC/tmp_kpp4palm
+! Time                 : Tue Sep 25 18:34:57 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
 ! Equation file        : chem_gasphase_mod.kpp
 ! Output root filename : chem_gasphase_mod
@@ -315,11 +325,8 @@
 
 
-  CHARACTER(len=15),PARAMETER,DIMENSION(2):: spc_names =  (/ &
+  CHARACTER(len=15), PARAMETER, DIMENSION(2):: spc_names =  (/ &
      'PM10           ','PM25           ' /)
 
-  INTEGER,DIMENSION(1):: lookat
-  INTEGER,DIMENSION(1):: monitor
-  CHARACTER(len=15),DIMENSION(1):: smass
-  CHARACTER(len=100),PARAMETER,DIMENSION(2):: eqn_names =  (/ &
+  CHARACTER(len=100), PARAMETER, DIMENSION(2):: eqn_names =  (/ &
      'PM10 --> PM10                                                                                       ',&
      'PM25 --> PM25                                                                                       ' /)
@@ -329,11 +336,11 @@
   !   inline f90_data: declaration of global variables for photolysis
   !   REAL(kind=dp):: phot(nphot)must eventually be moved to global later for 
-  INTEGER,PARAMETER :: nphot = 1
+  INTEGER, PARAMETER :: nphot = 1
   !   phot photolysis frequencies
   REAL(kind=dp):: phot(nphot)
 
-  INTEGER,PARAMETER,PUBLIC :: j_no2 = 1
-
-  CHARACTER(len=15),PARAMETER,DIMENSION(nphot):: phot_names =   (/ &
+  INTEGER, PARAMETER, PUBLIC :: j_no2 = 1
+
+  CHARACTER(len=15), PARAMETER, DIMENSION(nphot):: phot_names =   (/ &
      'J_NO2          '/)
 
@@ -367,6 +374,6 @@
 ! 
 ! File                 : chem_gasphase_mod_Initialize.f90
-! Time                 : Fri Dec  8 11:54:15 2017
-! Working directory    : /home/forkel-r/palmstuff/work/chemistry20171117/GASPHASE_PREPROC/tmp_kpp4palm
+! Time                 : Tue Sep 25 18:34:57 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
 ! Equation file        : chem_gasphase_mod.kpp
 ! Output root filename : chem_gasphase_mod
@@ -393,6 +400,6 @@
 ! 
 ! File                 : chem_gasphase_mod_Integrator.f90
-! Time                 : Fri Dec  8 11:54:15 2017
-! Working directory    : /home/forkel-r/palmstuff/work/chemistry20171117/GASPHASE_PREPROC/tmp_kpp4palm
+! Time                 : Tue Sep 25 18:34:57 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
 ! Equation file        : chem_gasphase_mod.kpp
 ! Output root filename : chem_gasphase_mod
@@ -432,7 +439,7 @@
   
 !~~~>  statistics on the work performed by the rosenbrock method
-  INTEGER,PARAMETER :: nfun=1,njac=2,nstp=3,nacc=4,&
-                        nrej=5,ndec=6,nsol=7,nsng=8,&
-                        ntexit=1,nhexit=2,nhnew = 3
+  INTEGER, PARAMETER :: nfun=1, njac=2, nstp=3, nacc=4, &
+                        nrej=5, ndec=6, nsol=7, nsng=8, &
+                        ntexit=1, nhexit=2, nhnew = 3
 
 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -451,6 +458,6 @@
 ! 
 ! File                 : chem_gasphase_mod_LinearAlgebra.f90
-! Time                 : Fri Dec  8 11:54:15 2017
-! Working directory    : /home/forkel-r/palmstuff/work/chemistry20171117/GASPHASE_PREPROC/tmp_kpp4palm
+! Time                 : Tue Sep 25 18:34:57 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
 ! Equation file        : chem_gasphase_mod.kpp
 ! Output root filename : chem_gasphase_mod
@@ -478,6 +485,6 @@
 ! 
 ! File                 : chem_gasphase_mod_Jacobian.f90
-! Time                 : Fri Dec  8 11:54:15 2017
-! Working directory    : /home/forkel-r/palmstuff/work/chemistry20171117/GASPHASE_PREPROC/tmp_kpp4palm
+! Time                 : Tue Sep 25 18:34:57 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
 ! Equation file        : chem_gasphase_mod.kpp
 ! Output root filename : chem_gasphase_mod
@@ -505,6 +512,6 @@
 ! 
 ! File                 : chem_gasphase_mod_Function.f90
-! Time                 : Fri Dec  8 11:54:15 2017
-! Working directory    : /home/forkel-r/palmstuff/work/chemistry20171117/GASPHASE_PREPROC/tmp_kpp4palm
+! Time                 : Tue Sep 25 18:34:57 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
 ! Equation file        : chem_gasphase_mod.kpp
 ! Output root filename : chem_gasphase_mod
@@ -534,6 +541,6 @@
 ! 
 ! File                 : chem_gasphase_mod_Rates.f90
-! Time                 : Fri Dec  8 11:54:15 2017
-! Working directory    : /home/forkel-r/palmstuff/work/chemistry20171117/GASPHASE_PREPROC/tmp_kpp4palm
+! Time                 : Tue Sep 25 18:34:57 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
 ! Equation file        : chem_gasphase_mod.kpp
 ! Output root filename : chem_gasphase_mod
@@ -560,6 +567,6 @@
 ! 
 ! File                 : chem_gasphase_mod_Util.f90
-! Time                 : Fri Dec  8 11:54:15 2017
-! Working directory    : /home/forkel-r/palmstuff/work/chemistry20171117/GASPHASE_PREPROC/tmp_kpp4palm
+! Time                 : Tue Sep 25 18:34:57 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
 ! Equation file        : chem_gasphase_mod.kpp
 ! Output root filename : chem_gasphase_mod
@@ -575,11 +582,11 @@
 
   ! notes:
-  ! -  l_vector is automatically defined by kp4
-  ! -  vl_dim is automatically defined by kp4
-  ! -  i_lu_di is automatically defined by kp4
-  ! -  wanted is automatically defined by xmecca
-  ! -  icntrl rcntrl are automatically defined by kpp
-  ! -  "USE messy_main_tools" is in MODULE_header of messy_mecca_kpp.f90
-  ! -  SAVE will be automatically added by kp4
+  ! - l_vector is automatically defined by kp4
+  ! - vl_dim is automatically defined by kp4
+  ! - i_lu_di is automatically defined by kp4
+  ! - wanted is automatically defined by xmecca
+  ! - icntrl rcntrl are automatically defined by kpp
+  ! - "USE messy_main_tools" is in MODULE_header of messy_mecca_kpp.f90
+  ! - SAVE will be automatically added by kp4
 
   !SAVE
@@ -587,14 +594,14 @@
   ! for fixed time step control
   ! ... max. number of fixed time steps (sum must be 1)
-  INTEGER,PARAMETER         :: nmaxfixsteps = 50
+  INTEGER, PARAMETER         :: nmaxfixsteps = 50
   ! ... switch for fixed time stepping
-  LOGICAL,PUBLIC            :: l_fixed_step = .false.
-  INTEGER,PUBLIC            :: nfsteps = 1
+  LOGICAL, PUBLIC            :: l_fixed_step = .FALSE.
+  INTEGER, PUBLIC            :: nfsteps = 1
   ! ... number of kpp control PARAMETERs
-  INTEGER,PARAMETER,PUBLIC :: nkppctrl = 20
+  INTEGER, PARAMETER, PUBLIC :: nkppctrl = 20
   !
-  INTEGER, DIMENSION(nkppctrl),PUBLIC     :: icntrl = 0
-  REAL(dp),DIMENSION(nkppctrl),PUBLIC     :: rcntrl = 0.0_dp
-  REAL(dp),DIMENSION(nmaxfixsteps),PUBLIC :: t_steps = 0.0_dp
+  INTEGER, DIMENSION(nkppctrl), PUBLIC     :: icntrl = 0
+  REAL(dp), DIMENSION(nkppctrl), PUBLIC     :: rcntrl = 0.0_dp
+  REAL(dp), DIMENSION(nmaxfixsteps), PUBLIC :: t_steps = 0.0_dp
 
   ! END header MODULE initialize_kpp_ctrl_template
@@ -619,73 +626,56 @@
   END INTERFACE        kppsolve
  
+  INTERFACE            jac_sp
+    MODULE PROCEDURE   jac_sp
+  END INTERFACE        jac_sp
+ 
+  INTERFACE            k_arr
+    MODULE PROCEDURE   k_arr
+  END INTERFACE        k_arr
+ 
+  INTERFACE            update_rconst
+    MODULE PROCEDURE   update_rconst
+  END INTERFACE        update_rconst
+ 
+  INTERFACE            arr2
+    MODULE PROCEDURE   arr2
+  END INTERFACE        arr2
+ 
+  INTERFACE            initialize_kpp_ctrl
+    MODULE PROCEDURE   initialize_kpp_ctrl
+  END INTERFACE        initialize_kpp_ctrl
+ 
+  INTERFACE            error_output
+    MODULE PROCEDURE   error_output
+  END INTERFACE        error_output
+ 
+  INTERFACE            wscal
+    MODULE PROCEDURE   wscal
+  END INTERFACE        wscal
+ 
+!INTERFACE not working  INTERFACE            waxpy
+!INTERFACE not working    MODULE PROCEDURE   waxpy
+!INTERFACE not working  END INTERFACE        waxpy
+ 
+  INTERFACE            rosenbrock
+    MODULE PROCEDURE   rosenbrock
+  END INTERFACE        rosenbrock
+ 
+  INTERFACE            funtemplate
+    MODULE PROCEDURE   funtemplate
+  END INTERFACE        funtemplate
+ 
+  INTERFACE            jactemplate
+    MODULE PROCEDURE   jactemplate
+  END INTERFACE        jactemplate
+ 
   INTERFACE            kppdecomp
     MODULE PROCEDURE   kppdecomp
   END INTERFACE        kppdecomp
  
-  INTERFACE            wlamch
-    MODULE PROCEDURE   wlamch
-  END INTERFACE        wlamch
- 
-  INTERFACE            wlamch_add
-    MODULE PROCEDURE   wlamch_add
-  END INTERFACE        wlamch_add
- 
-  INTERFACE            jac_sp
-    MODULE PROCEDURE   jac_sp
-  END INTERFACE        jac_sp
- 
-  INTERFACE            k_arr
-    MODULE PROCEDURE   k_arr
-  END INTERFACE        k_arr
- 
-  INTERFACE            update_rconst
-    MODULE PROCEDURE   update_rconst
-  END INTERFACE        update_rconst
- 
-  INTERFACE            arr2
-    MODULE PROCEDURE   arr2
-  END INTERFACE        arr2
- 
-  INTERFACE            initialize_kpp_ctrl
-    MODULE PROCEDURE   initialize_kpp_ctrl
-  END INTERFACE        initialize_kpp_ctrl
- 
-  INTERFACE            error_output
-    MODULE PROCEDURE   error_output
-  END INTERFACE        error_output
- 
-!interface not working  INTERFACE            wcopy
-!interface not working    MODULE PROCEDURE   wcopy
-!interface not working  END INTERFACE        wcopy
- 
-  INTERFACE            wscal
-    MODULE PROCEDURE   wscal
-  END INTERFACE        wscal
- 
-!interface not working  INTERFACE            waxpy
-!interface not working    MODULE PROCEDURE   waxpy
-!interface not working  END INTERFACE        waxpy
- 
-  INTERFACE            rosenbrock
-    MODULE PROCEDURE   rosenbrock
-  END INTERFACE        rosenbrock
- 
-  INTERFACE            funtemplate
-    MODULE PROCEDURE   funtemplate
-  END INTERFACE        funtemplate
- 
-  INTERFACE            jactemplate
-    MODULE PROCEDURE   jactemplate
-  END INTERFACE        jactemplate
- 
   INTERFACE            chem_gasphase_integrate
     MODULE PROCEDURE   chem_gasphase_integrate
   END INTERFACE        chem_gasphase_integrate
  
-  INTERFACE            fill_temp
-    MODULE PROCEDURE   fill_temp
-  END INTERFACE        fill_temp
-  PUBLIC               fill_temp
- 
  
  CONTAINS
@@ -694,17 +684,17 @@
 
 
+  INTEGER         :: j, k
 
   INTEGER :: i
   REAL(kind=dp):: x
-
+  k = is
   cfactor = 1.000000e+00_dp
 
-  x = (0.)*cfactor
-  DO i = 1,nvar
-    var(i) = x
+  x = (0.) * cfactor
+  DO i = 1 , nvar
   ENDDO
 
-  x = (0.)*cfactor
-  DO i = 1,nfix
+  x = (0.) * cfactor
+  DO i = 1 , nfix
     fix(i) = x
   ENDDO
@@ -720,21 +710,21 @@
 END SUBROUTINE initialize
  
-SUBROUTINE integrate( tin,tout,&
-  icntrl_u,rcntrl_u,istatus_u,rstatus_u,ierr_u)
-
-
-   REAL(kind=dp),INTENT(in):: tin  ! start time
-   REAL(kind=dp),INTENT(in):: tout ! END time
+SUBROUTINE integrate( tin, tout, &
+  icntrl_u, rcntrl_u, istatus_u, rstatus_u, ierr_u)
+
+
+   REAL(kind=dp), INTENT(IN):: tin  ! start time
+   REAL(kind=dp), INTENT(IN):: tout ! END time
    ! OPTIONAL input PARAMETERs and statistics
-   INTEGER,      INTENT(in), OPTIONAL :: icntrl_u(20)
-   REAL(kind=dp),INTENT(in), OPTIONAL :: rcntrl_u(20)
-   INTEGER,      INTENT(out),OPTIONAL :: istatus_u(20)
-   REAL(kind=dp),INTENT(out),OPTIONAL :: rstatus_u(20)
-   INTEGER,      INTENT(out),OPTIONAL :: ierr_u
-
-   REAL(kind=dp):: rcntrl(20),rstatus(20)
-   INTEGER       :: icntrl(20),istatus(20),ierr
-
-   INTEGER,SAVE :: ntotal = 0
+   INTEGER,      INTENT(IN), OPTIONAL :: icntrl_u(20)
+   REAL(kind=dp), INTENT(IN), OPTIONAL :: rcntrl_u(20)
+   INTEGER,      INTENT(OUT), OPTIONAL :: istatus_u(20)
+   REAL(kind=dp), INTENT(OUT), OPTIONAL :: rstatus_u(20)
+   INTEGER,      INTENT(OUT), OPTIONAL :: ierr_u
+
+   REAL(kind=dp):: rcntrl(20), rstatus(20)
+   INTEGER       :: icntrl(20), istatus(20), ierr
+
+   INTEGER, SAVE :: ntotal = 0
 
    icntrl(:) = 0
@@ -744,20 +734,20 @@
 
     !~~~> fine-tune the integrator:
-   icntrl(1) = 0	! 0 -  non- autonomous,1 -  autonomous
-   icntrl(2) = 0	! 0 -  vector tolerances,1 -  scalars
-
-   ! IF OPTIONAL PARAMETERs are given,and IF they are >0,
+   icntrl(1) = 0      ! 0 - non- autonomous, 1 - autonomous
+   icntrl(2) = 0      ! 0 - vector tolerances, 1 - scalars
+
+   ! IF OPTIONAL PARAMETERs are given, and IF they are >0, 
    ! THEN they overwrite default settings. 
-   IF (present(icntrl_u))THEN
-     where(icntrl_u(:)> 0)icntrl(:) = icntrl_u(:)
+   IF (PRESENT(icntrl_u))THEN
+     WHERE(icntrl_u(:)> 0)icntrl(:) = icntrl_u(:)
    ENDIF
-   IF (present(rcntrl_u))THEN
-     where(rcntrl_u(:)> 0)rcntrl(:) = rcntrl_u(:)
+   IF (PRESENT(rcntrl_u))THEN
+     WHERE(rcntrl_u(:)> 0)rcntrl(:) = rcntrl_u(:)
    ENDIF
 
 
-   CALL rosenbrock(nvar,var,tin,tout,  &
-         atol,rtol,               &
-         rcntrl,icntrl,rstatus,istatus,ierr)
+   CALL rosenbrock(nvar, var, tin, tout,  &
+         atol, rtol,               &
+         rcntrl, icntrl, rstatus, istatus, ierr)
 
    !~~~> debug option: show no of steps
@@ -768,11 +758,11 @@
    ! IF OPTIONAL PARAMETERs are given for output they 
    ! are updated with the RETURN information
-   IF (present(istatus_u))istatus_u(:) = istatus(:)
-   IF (present(rstatus_u))rstatus_u(:) = rstatus(:)
-   IF (present(ierr_u))   ierr_u       = ierr
+   IF (PRESENT(istatus_u))istatus_u(:) = istatus(:)
+   IF (PRESENT(rstatus_u))rstatus_u(:) = rstatus(:)
+   IF (PRESENT(ierr_u))  ierr_u       = ierr
 
 END SUBROUTINE integrate
  
-SUBROUTINE fun(v,f,rct,vdot)
+SUBROUTINE fun(v, f, rct, vdot)
 
 ! V - Concentrations of variable species (local)
@@ -794,5 +784,5 @@
 END SUBROUTINE fun
  
-SUBROUTINE kppsolve(jvs,x)
+SUBROUTINE kppsolve(jvs, x)
 
 ! JVS - sparse Jacobian of variables
@@ -801,89 +791,10 @@
   REAL(kind=dp):: x(nvar)
 
-  x(2) = x(2)/ jvs(2)
-  x(1) = x(1)/ jvs(1)
+  x(2) = x(2) / jvs(2)
+  x(1) = x(1) / jvs(1)
       
 END SUBROUTINE kppsolve
  
-SUBROUTINE kppdecomp( jvs,ier)
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!        Sparse LU factorization
-! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-
-      INTEGER  :: ier
-      REAL(kind=dp):: jvs(lu_nonzero),w(nvar),a
-      INTEGER  :: k,kk,j,jj
-
-      a = 0. ! mz_rs_20050606
-      ier = 0
-      DO k=1,nvar
-        ! mz_rs_20050606: don't check if real value == 0
-        ! IF(jvs( lu_diag(k)).eq. 0.)THEN
-        IF(abs(jvs(lu_diag(k)))< tiny(a))THEN
-            ier = k
-            RETURN
-        ENDIF
-        DO kk = lu_crow(k),lu_crow(k+ 1)- 1
-              w( lu_icol(kk)) = jvs(kk)
-        ENDDO
-        DO kk = lu_crow(k),lu_diag(k)- 1
-            j = lu_icol(kk)
-            a = - w(j)/ jvs( lu_diag(j))
-            w(j) = - a
-            DO jj = lu_diag(j)+ 1,lu_crow(j+ 1)- 1
-               w( lu_icol(jj)) = w( lu_icol(jj))+ a*jvs(jj)
-            ENDDO
-         ENDDO
-         DO kk = lu_crow(k),lu_crow(k+ 1)- 1
-            jvs(kk) = w( lu_icol(kk))
-         ENDDO
-      ENDDO
-      
-END SUBROUTINE kppdecomp
- 
-      REAL(kind=dp)FUNCTION wlamch( c)
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
-!     returns epsilon machine
-!     after LAPACK
-!     replace this by the function from the optimized LAPACK implementation:
-!          CALL SLAMCH('E') or CALL DLAMCH('E')
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
-!      USE chem_gasphase_mod_Precision
-
-      CHARACTER ::  c
-      INTEGER    :: i
-      REAL(kind=dp),SAVE  ::  eps
-      REAL(kind=dp) ::  suma
-      REAL(kind=dp),PARAMETER  ::  one=1.0_dp, half=0.5_dp
-      LOGICAL,SAVE   ::  first=.true.
-      
-      IF (first)THEN
-        first = .false.
-        eps = half**(16)
-        DO i = 17,80
-          eps = eps*half
-          CALL wlamch_add(one,eps,suma)
-          IF (suma.le.one)goto 10
-        ENDDO
-        PRINT*,'ERROR IN WLAMCH. EPS < ',Eps
-        RETURN
-10      eps = eps*2
-        i = i- 1      
-      ENDIF
-
-      wlamch = eps
-
-      END FUNCTION wlamch
- 
-      SUBROUTINE wlamch_add( a,b,suma)
-!      USE chem_gasphase_mod_Precision
-      
-      REAL(kind=dp)a,b,suma
-      suma = a + b
-
-      END SUBROUTINE wlamch_add
- 
-SUBROUTINE jac_sp(v,f,rct,jvs)
+SUBROUTINE jac_sp(v, f, rct, jvs)
 
 ! V - Concentrations of variable species (local)
@@ -914,19 +825,19 @@
 END SUBROUTINE jac_sp
  
-  elemental REAL(kind=dp)FUNCTION k_arr (k_298,tdep,temp)
+  elemental REAL(kind=dp)FUNCTION k_arr (k_298, tdep, temp)
     ! arrhenius FUNCTION
 
-    REAL,    INTENT(in):: k_298 ! k at t = 298.15k
-    REAL,    INTENT(in):: tdep  ! temperature dependence
-    REAL(kind=dp),INTENT(in):: temp  ! temperature
+    REAL,    INTENT(IN):: k_298 ! k at t = 298.15k
+    REAL,    INTENT(IN):: tdep  ! temperature dependence
+    REAL(kind=dp), INTENT(IN):: temp  ! temperature
 
     intrinsic exp
 
-    k_arr = k_298 *exp(tdep*(1._dp/temp- 3.3540e-3_dp))! 1/298.15=3.3540e-3
+    k_arr = k_298 * exp(tdep* (1._dp/temp- 3.3540e-3_dp))! 1/298.15=3.3540e-3
 
   END FUNCTION k_arr
  
 SUBROUTINE update_rconst()
- INTEGER         :: j,k
+ INTEGER         :: k
 
   k = is
@@ -942,17 +853,16 @@
 END SUBROUTINE update_rconst
  
-REAL(kind=dp)FUNCTION arr2( a0,b0,temp)
+!  END FUNCTION ARR2
+REAL(kind=dp)FUNCTION arr2( a0, b0, temp)
     REAL(kind=dp):: temp
-    REAL(kind=dp):: a0,b0
-    arr2 = a0 *exp( - b0 / temp)
+    REAL(kind=dp):: a0, b0
+    arr2 = a0 * exp( - b0 / temp)
 END FUNCTION arr2
  
-SUBROUTINE initialize_kpp_ctrl(status,iou,modstr)
+SUBROUTINE initialize_kpp_ctrl(status)
 
 
   ! i/o
-  INTEGER,         INTENT(out):: status
-  INTEGER,         INTENT(in) :: iou     ! LOGICAL i/o unit
-  CHARACTER(len=*),INTENT(in) :: modstr  ! read <modstr>.nml
+  INTEGER,         INTENT(OUT):: status
 
   ! local
@@ -962,5 +872,5 @@
   ! check fixed time steps
   tsum = 0.0_dp
-  DO i=1,nmaxfixsteps
+  DO i=1, nmaxfixsteps
      IF (t_steps(i)< tiny(0.0_dp))exit
      tsum = tsum + t_steps(i)
@@ -982,5 +892,5 @@
   WRITE(*,*) ' RCNTRL           : ',rcntrl
   !
-  ! note: this is only meaningful for vectorized (kp4)rosenbrock- methods
+  ! note: this is ONLY meaningful for vectorized (kp4)rosenbrock- methods
   IF (l_vector)THEN
      IF (l_fixed_step)THEN
@@ -1000,10 +910,10 @@
 END SUBROUTINE initialize_kpp_ctrl
  
-SUBROUTINE error_output(c,ierr,pe)
-
-
-  INTEGER,INTENT(in):: ierr
-  INTEGER,INTENT(in):: pe
-  REAL(dp),DIMENSION(:),INTENT(in):: c
+SUBROUTINE error_output(c, ierr, pe)
+
+
+  INTEGER, INTENT(IN):: ierr
+  INTEGER, INTENT(IN):: pe
+  REAL(dp), DIMENSION(:), INTENT(IN):: c
 
   write(6,*) 'ERROR in chem_gasphase_mod ',ierr,C(1)
@@ -1012,41 +922,5 @@
 END SUBROUTINE error_output
  
-      SUBROUTINE wcopy(n,x,incx,y,incy)
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
-!     copies a vector,x,to a vector,y:  y <- x
-!     only for incX=incY=1
-!     after BLAS
-!     replace this by the function from the optimized BLAS implementation:
-!         CALL  SCOPY(N,X,1,Y,1)   or   CALL  DCOPY(N,X,1,Y,1)
-!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
-!     USE chem_gasphase_mod_Precision
-      
-      INTEGER  :: i,incx,incy,m,mp1,n
-      REAL(kind=dp):: x(n),y(n)
-
-      IF (n.le.0)RETURN
-
-      m = mod(n,8)
-      IF( m .ne. 0)THEN
-        DO i = 1,m
-          y(i) = x(i)
-        ENDDO
-        IF( n .lt. 8)RETURN
-      ENDIF    
-      mp1 = m+ 1
-      DO i = mp1,n,8
-        y(i) = x(i)
-        y(i + 1) = x(i + 1)
-        y(i + 2) = x(i + 2)
-        y(i + 3) = x(i + 3)
-        y(i + 4) = x(i + 4)
-        y(i + 5) = x(i + 5)
-        y(i + 6) = x(i + 6)
-        y(i + 7) = x(i + 7)
-      ENDDO
-
-      END SUBROUTINE wcopy
- 
-      SUBROUTINE wscal(n,alpha,x,incx)
+      SUBROUTINE wscal(n, alpha, x, incx)
 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
 !     constant times a vector: x(1:N) <- Alpha*x(1:N) 
@@ -1057,32 +931,32 @@
 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
 
-      INTEGER  :: i,incx,m,mp1,n
-      REAL(kind=dp) :: x(n),alpha
-      REAL(kind=dp),PARAMETER  :: zero=0.0_dp, one=1.0_dp
+      INTEGER  :: i, incx, m, mp1, n
+      REAL(kind=dp) :: x(n), alpha
+      REAL(kind=dp), PARAMETER  :: zero=0.0_dp, one=1.0_dp
 
       IF (alpha .eq. one)RETURN
       IF (n .le. 0)RETURN
 
-      m = mod(n,5)
-      IF( m .ne. 0)THEN
+      m = mod(n, 5)
+      IF ( m .ne. 0)THEN
         IF (alpha .eq. (- one))THEN
-          DO i = 1,m
+          DO i = 1, m
             x(i) = - x(i)
           ENDDO
         ELSEIF (alpha .eq. zero)THEN
-          DO i = 1,m
+          DO i = 1, m
             x(i) = zero
           ENDDO
         ELSE
-          DO i = 1,m
-            x(i) = alpha*x(i)
+          DO i = 1, m
+            x(i) = alpha* x(i)
           ENDDO
         ENDIF
-        IF( n .lt. 5)RETURN
+        IF ( n .lt. 5)RETURN
       ENDIF
       mp1 = m + 1
       IF (alpha .eq. (- one))THEN
-        DO i = mp1,n,5
-          x(i)    = - x(i)
+        DO i = mp1, n, 5
+          x(i)   = - x(i)
           x(i + 1) = - x(i + 1)
           x(i + 2) = - x(i + 2)
@@ -1091,6 +965,6 @@
         ENDDO
       ELSEIF (alpha .eq. zero)THEN
-        DO i = mp1,n,5
-          x(i)    = zero
+        DO i = mp1, n, 5
+          x(i)   = zero
           x(i + 1) = zero
           x(i + 2) = zero
@@ -1099,10 +973,10 @@
         ENDDO
       ELSE
-        DO i = mp1,n,5
-          x(i)    = alpha*x(i)
-          x(i + 1) = alpha*x(i + 1)
-          x(i + 2) = alpha*x(i + 2)
-          x(i + 3) = alpha*x(i + 3)
-          x(i + 4) = alpha*x(i + 4)
+        DO i = mp1, n, 5
+          x(i)   = alpha* x(i)
+          x(i + 1) = alpha* x(i + 1)
+          x(i + 2) = alpha* x(i + 2)
+          x(i + 3) = alpha* x(i + 3)
+          x(i + 4) = alpha* x(i + 4)
         ENDDO
       ENDIF
@@ -1110,5 +984,5 @@
       END SUBROUTINE wscal
  
-      SUBROUTINE waxpy(n,alpha,x,incx,y,incy)
+      SUBROUTINE waxpy(n, alpha, x, incx, y, incy)
 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
 !     constant times a vector plus a vector: y <- y + Alpha*x
@@ -1119,31 +993,31 @@
 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
 
-      INTEGER  :: i,incx,incy,m,mp1,n
-      REAL(kind=dp):: x(n),y(n),alpha
-      REAL(kind=dp),PARAMETER :: zero = 0.0_dp
+      INTEGER  :: i, incx, incy, m, mp1, n
+      REAL(kind=dp):: x(n), y(n), alpha
+      REAL(kind=dp), PARAMETER :: zero = 0.0_dp
 
       IF (alpha .eq. zero)RETURN
       IF (n .le. 0)RETURN
 
-      m = mod(n,4)
-      IF( m .ne. 0)THEN
-        DO i = 1,m
-          y(i) = y(i)+ alpha*x(i)
+      m = mod(n, 4)
+      IF ( m .ne. 0)THEN
+        DO i = 1, m
+          y(i) = y(i) + alpha* x(i)
         ENDDO
-        IF( n .lt. 4)RETURN
+        IF ( n .lt. 4)RETURN
       ENDIF
       mp1 = m + 1
-      DO i = mp1,n,4
-        y(i) = y(i)+ alpha*x(i)
-        y(i + 1) = y(i + 1)+ alpha*x(i + 1)
-        y(i + 2) = y(i + 2)+ alpha*x(i + 2)
-        y(i + 3) = y(i + 3)+ alpha*x(i + 3)
+      DO i = mp1, n, 4
+        y(i) = y(i) + alpha* x(i)
+        y(i + 1) = y(i + 1) + alpha* x(i + 1)
+        y(i + 2) = y(i + 2) + alpha* x(i + 2)
+        y(i + 3) = y(i + 3) + alpha* x(i + 3)
       ENDDO
       
       END SUBROUTINE waxpy
  
-SUBROUTINE rosenbrock(n,y,tstart,tend,&
-           abstol,reltol,             &
-           rcntrl,icntrl,rstatus,istatus,ierr)
+SUBROUTINE rosenbrock(n, y, tstart, tend, &
+           abstol, reltol,             &
+           rcntrl, icntrl, rstatus, istatus, ierr)
 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 !
@@ -1172,22 +1046,22 @@
 !~~~>   input arguments:
 !
-!-      y(n)   = vector of initial conditions (at t=tstart)
-!-     [tstart,tend]  = time range of integration
+!-     y(n)  = vector of initial conditions (at t=tstart)
+!-    [tstart, tend]  = time range of integration
 !     (if Tstart>Tend the integration is performed backwards in time)
-!-     reltol,abstol = user precribed accuracy
-!-  SUBROUTINE  fun( t,y,ydot) = ode FUNCTION,
+!-    reltol, abstol = user precribed accuracy
+!- SUBROUTINE  fun( t, y, ydot) = ode FUNCTION, 
 !                       returns Ydot = Y' = F(T,Y)
-!-  SUBROUTINE  jac( t,y,jcb) = jacobian of the ode FUNCTION,
+!- SUBROUTINE  jac( t, y, jcb) = jacobian of the ode FUNCTION, 
 !                       returns Jcb = dFun/dY
-!-     icntrl(1:20)   = INTEGER inputs PARAMETERs
-!-     rcntrl(1:20)   = REAL inputs PARAMETERs
+!-    icntrl(1:20)  = INTEGER inputs PARAMETERs
+!-    rcntrl(1:20)  = REAL inputs PARAMETERs
 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 !
 !~~~>     output arguments:
 !
-!-     y(n)   - > vector of final states (at t- >tEND)
-!-     istatus(1:20)  - > INTEGER output PARAMETERs
-!-     rstatus(1:20)  - > REAL output PARAMETERs
-!-     ierr            - > job status upon RETURN
+!-    y(n)  - > vector of final states (at t- >tend)
+!-    istatus(1:20) - > INTEGER output PARAMETERs
+!-    rstatus(1:20) - > REAL output PARAMETERs
+!-    ierr            - > job status upon RETURN
 !                        success (positive value) or
 !                        failure (negative value)
@@ -1262,29 +1136,29 @@
 
 !~~~>  arguments
-   INTEGER,      INTENT(in)   :: n
-   REAL(kind=dp),INTENT(inout):: y(n)
-   REAL(kind=dp),INTENT(in)   :: tstart,tend
-   REAL(kind=dp),INTENT(in)   :: abstol(n),reltol(n)
-   INTEGER,      INTENT(in)   :: icntrl(20)
-   REAL(kind=dp),INTENT(in)   :: rcntrl(20)
-   INTEGER,      INTENT(inout):: istatus(20)
-   REAL(kind=dp),INTENT(inout):: rstatus(20)
-   INTEGER,INTENT(out)  :: ierr
-!~~~>  PARAMETERs of the rosenbrock method,up to 6 stages
-   INTEGER ::  ros_s,rosmethod
-   INTEGER,PARAMETER :: rs2=1,rs3=2,rs4=3,rd3=4,rd4=5,rg3=6
-   REAL(kind=dp):: ros_a(15),ros_c(15),ros_m(6),ros_e(6),&
-                    ros_alpha(6),ros_gamma(6),ros_elo
+   INTEGER,      INTENT(IN)  :: n
+   REAL(kind=dp), INTENT(INOUT):: y(n)
+   REAL(kind=dp), INTENT(IN)  :: tstart, tend
+   REAL(kind=dp), INTENT(IN)  :: abstol(n), reltol(n)
+   INTEGER,      INTENT(IN)  :: icntrl(20)
+   REAL(kind=dp), INTENT(IN)  :: rcntrl(20)
+   INTEGER,      INTENT(INOUT):: istatus(20)
+   REAL(kind=dp), INTENT(INOUT):: rstatus(20)
+   INTEGER, INTENT(OUT) :: ierr
+!~~~>  PARAMETERs of the rosenbrock method, up to 6 stages
+   INTEGER ::  ros_s, rosmethod
+   INTEGER, PARAMETER :: rs2=1, rs3=2, rs4=3, rd3=4, rd4=5, rg3=6
+   REAL(kind=dp):: ros_a(15), ros_c(15), ros_m(6), ros_e(6), &
+                    ros_alpha(6), ros_gamma(6), ros_elo
    LOGICAL :: ros_newf(6)
    CHARACTER(len=12):: ros_name
 !~~~>  local variables
-   REAL(kind=dp):: roundoff,facmin,facmax,facrej,facsafe
-   REAL(kind=dp):: hmin,hmax,hstart
+   REAL(kind=dp):: roundoff, facmin, facmax, facrej, facsafe
+   REAL(kind=dp):: hmin, hmax, hstart
    REAL(kind=dp):: texit
-   INTEGER       :: i,uplimtol,max_no_steps
-   LOGICAL       :: autonomous,vectortol
+   INTEGER       :: i, uplimtol, max_no_steps
+   LOGICAL       :: autonomous, vectortol
 !~~~>   PARAMETERs
-   REAL(kind=dp),PARAMETER :: zero = 0.0_dp, one  = 1.0_dp
-   REAL(kind=dp),PARAMETER :: deltamin = 1.0e-5_dp
+   REAL(kind=dp), PARAMETER :: zero = 0.0_dp, one  = 1.0_dp
+   REAL(kind=dp), PARAMETER :: deltamin = 1.0e-5_dp
 
 !~~~>  initialize statistics
@@ -1298,8 +1172,8 @@
 !   For Vector tolerances (ICNTRL(2) == 0) the code uses AbsTol(1:N) and RelTol(1:N)
    IF (icntrl(2) == 0)THEN
-      vectortol = .true.
+      vectortol = .TRUE.
       uplimtol  = n
    ELSE
-      vectortol = .false.
+      vectortol = .FALSE.
       uplimtol  = 1
    ENDIF
@@ -1313,5 +1187,5 @@
      CASE (3)
        CALL ros4
-     CASE (0,4)
+     CASE (0, 4)
        CALL rodas3
      CASE (5)
@@ -1321,5 +1195,5 @@
      CASE default
        PRINT *,'Unknown Rosenbrock method: ICNTRL(3) =',ICNTRL(3) 
-       CALL ros_errormsg(- 2,tstart,zero,ierr)
+       CALL ros_errormsg(- 2, tstart, zero, ierr)
        RETURN
    END select
@@ -1332,10 +1206,10 @@
    ELSE
       PRINT *,'User-selected max no. of steps: ICNTRL(4) =',ICNTRL(4)
-      CALL ros_errormsg(- 1,tstart,zero,ierr)
+      CALL ros_errormsg(- 1, tstart, zero, ierr)
       RETURN
    ENDIF
 
 !~~~>  unit roundoff (1+ roundoff>1)
-   Roundoff = WLAMCH('E')
+   roundoff = epsilon(one)
 
 !~~~>  lower bound on the step size: (positive value)
@@ -1346,5 +1220,5 @@
    ELSE
       PRINT *,'User-selected Hmin: RCNTRL(1) =',RCNTRL(1)
-      CALL ros_errormsg(- 3,tstart,zero,ierr)
+      CALL ros_errormsg(- 3, tstart, zero, ierr)
       RETURN
    ENDIF
@@ -1353,18 +1227,18 @@
       hmax = abs(tend-tstart)
    ELSEIF (rcntrl(2)> zero)THEN
-      hmax = min(abs(rcntrl(2)),abs(tend-tstart))
+      hmax = min(abs(rcntrl(2)), abs(tend-tstart))
    ELSE
       PRINT *,'User-selected Hmax: RCNTRL(2) =',RCNTRL(2)
-      CALL ros_errormsg(- 3,tstart,zero,ierr)
+      CALL ros_errormsg(- 3, tstart, zero, ierr)
       RETURN
    ENDIF
 !~~~>  starting step size: (positive value)
    IF (rcntrl(3) == zero)THEN
-      hstart = max(hmin,deltamin)
+      hstart = max(hmin, deltamin)
    ELSEIF (rcntrl(3)> zero)THEN
-      hstart = min(abs(rcntrl(3)),abs(tend-tstart))
+      hstart = min(abs(rcntrl(3)), abs(tend-tstart))
    ELSE
       PRINT *,'User-selected Hstart: RCNTRL(3) =',RCNTRL(3)
-      CALL ros_errormsg(- 3,tstart,zero,ierr)
+      CALL ros_errormsg(- 3, tstart, zero, ierr)
       RETURN
    ENDIF
@@ -1376,5 +1250,5 @@
    ELSE
       PRINT *,'User-selected FacMin: RCNTRL(4) =',RCNTRL(4)
-      CALL ros_errormsg(- 4,tstart,zero,ierr)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
       RETURN
    ENDIF
@@ -1385,5 +1259,5 @@
    ELSE
       PRINT *,'User-selected FacMax: RCNTRL(5) =',RCNTRL(5)
-      CALL ros_errormsg(- 4,tstart,zero,ierr)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
       RETURN
    ENDIF
@@ -1395,5 +1269,5 @@
    ELSE
       PRINT *,'User-selected FacRej: RCNTRL(6) =',RCNTRL(6)
-      CALL ros_errormsg(- 4,tstart,zero,ierr)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
       RETURN
    ENDIF
@@ -1405,14 +1279,14 @@
    ELSE
       PRINT *,'User-selected FacSafe: RCNTRL(7) =',RCNTRL(7)
-      CALL ros_errormsg(- 4,tstart,zero,ierr)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
       RETURN
    ENDIF
 !~~~>  check IF tolerances are reasonable
-    DO i=1,uplimtol
-      IF((abstol(i)<= zero).or. (reltol(i)<= 10.0_dp*roundoff)&
+    DO i=1, uplimtol
+      IF ((abstol(i)<= zero).or. (reltol(i)<= 10.0_dp* roundoff)&
          .or. (reltol(i)>= 1.0_dp))THEN
         PRINT *,' AbsTol(',i,') = ',AbsTol(i)
         PRINT *,' RelTol(',i,') = ',RelTol(i)
-        CALL ros_errormsg(- 5,tstart,zero,ierr)
+        CALL ros_errormsg(- 5, tstart, zero, ierr)
         RETURN
       ENDIF
@@ -1421,10 +1295,10 @@
 
 !~~~>  CALL rosenbrock method
-   CALL ros_integrator(y,tstart,tend,texit,  &
-        abstol,reltol,                         &
+   CALL ros_integrator(y, tstart, tend, texit,  &
+        abstol, reltol,                         &
 !  Integration parameters
-        autonomous,vectortol,max_no_steps,    &
-        roundoff,hmin,hmax,hstart,           &
-        facmin,facmax,facrej,facsafe,        &
+        autonomous, vectortol, max_no_steps,    &
+        roundoff, hmin, hmax, hstart,           &
+        facmin, facmax, facrej, facsafe,        &
 !  Error indicator
         ierr)
@@ -1435,25 +1309,25 @@
    
 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
- SUBROUTINE ros_errormsg(code,t,h,ierr)
+ SUBROUTINE ros_errormsg(code, t, h, ierr)
 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
 !    Handles all error messages
 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
   
-   REAL(kind=dp),INTENT(in):: t,h
-   INTEGER,INTENT(in) :: code
-   INTEGER,INTENT(out):: ierr
+   REAL(kind=dp), INTENT(IN):: t, h
+   INTEGER, INTENT(IN) :: code
+   INTEGER, INTENT(OUT):: ierr
    
    ierr = code
-   print *,&
+   print * , &
      'Forced exit from Rosenbrock due to the following error:' 
      
    select CASE (code)
-    CASE (- 1)   
+    CASE (- 1)  
       PRINT *,'--> Improper value for maximal no of steps'
-    CASE (- 2)   
+    CASE (- 2)  
       PRINT *,'--> Selected Rosenbrock method not implemented'
-    CASE (- 3)   
+    CASE (- 3)  
       PRINT *,'--> Hmin/Hmax/Hstart must be positive'
-    CASE (- 4)   
+    CASE (- 4)  
       PRINT *,'--> FacMin/FacMax/FacRej must be positive'
     CASE (- 5)
@@ -1464,5 +1338,5 @@
       PRINT *,'--> Step size too small: T + 10*H = T',&
             ' or H < Roundoff'
-    CASE (- 8)   
+    CASE (- 8)  
       PRINT *,'--> Matrix is repeatedly singular'
     CASE default
@@ -1470,15 +1344,15 @@
    END select
    
-   print *,"t=",t,"and h=",h
+   print * , "t=", t, "and h=", h
      
  END SUBROUTINE ros_errormsg
 
 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- SUBROUTINE ros_integrator (y,tstart,tend,t, &
-        abstol,reltol,                         &
+ SUBROUTINE ros_integrator (y, tstart, tend, t, &
+        abstol, reltol,                         &
 !~~~> integration PARAMETERs
-        autonomous,vectortol,max_no_steps,    &
-        roundoff,hmin,hmax,hstart,           &
-        facmin,facmax,facrej,facsafe,        &
+        autonomous, vectortol, max_no_steps,    &
+        roundoff, hmin, hmax, hstart,           &
+        facmin, facmax, facrej, facsafe,        &
 !~~~> error indicator
         ierr)
@@ -1491,33 +1365,33 @@
 
 !~~~> input: the initial condition at tstart; output: the solution at t
-   REAL(kind=dp),INTENT(inout):: y(n)
+   REAL(kind=dp), INTENT(INOUT):: y(n)
 !~~~> input: integration interval
-   REAL(kind=dp),INTENT(in):: tstart,tend
-!~~~> output: time at which the solution is RETURNed (t=tENDIF success)
-   REAL(kind=dp),INTENT(out)::  t
+   REAL(kind=dp), INTENT(IN):: tstart, tend
+!~~~> output: time at which the solution is RETURNed (t=tendIF success)
+   REAL(kind=dp), INTENT(OUT)::  t
 !~~~> input: tolerances
-   REAL(kind=dp),INTENT(in)::  abstol(n),reltol(n)
+   REAL(kind=dp), INTENT(IN)::  abstol(n), reltol(n)
 !~~~> input: integration PARAMETERs
-   LOGICAL,INTENT(in):: autonomous,vectortol
-   REAL(kind=dp),INTENT(in):: hstart,hmin,hmax
-   INTEGER,INTENT(in):: max_no_steps
-   REAL(kind=dp),INTENT(in):: roundoff,facmin,facmax,facrej,facsafe
+   LOGICAL, INTENT(IN):: autonomous, vectortol
+   REAL(kind=dp), INTENT(IN):: hstart, hmin, hmax
+   INTEGER, INTENT(IN):: max_no_steps
+   REAL(kind=dp), INTENT(IN):: roundoff, facmin, facmax, facrej, facsafe
 !~~~> output: error indicator
-   INTEGER,INTENT(out):: ierr
+   INTEGER, INTENT(OUT):: ierr
 ! ~~~~ Local variables
-   REAL(kind=dp):: ynew(n),fcn0(n),fcn(n)
-   REAL(kind=dp):: k(n*ros_s),dfdt(n)
+   REAL(kind=dp):: ynew(n), fcn0(n), fcn(n)
+   REAL(kind=dp):: k(n* ros_s), dfdt(n)
 #ifdef full_algebra    
-   REAL(kind=dp):: jac0(n,n),ghimj(n,n)
+   REAL(kind=dp):: jac0(n, n), ghimj(n, n)
 #else
-   REAL(kind=dp):: jac0(lu_nonzero),ghimj(lu_nonzero)
+   REAL(kind=dp):: jac0(lu_nonzero), ghimj(lu_nonzero)
 #endif
-   REAL(kind=dp):: h,hnew,hc,hg,fac,tau
-   REAL(kind=dp):: err,yerr(n)
-   INTEGER :: pivot(n),direction,ioffset,j,istage
-   LOGICAL :: rejectlasth,rejectmoreh,singular
+   REAL(kind=dp):: h, hnew, hc, hg, fac, tau
+   REAL(kind=dp):: err, yerr(n)
+   INTEGER :: pivot(n), direction, ioffset, j, istage
+   LOGICAL :: rejectlasth, rejectmoreh, singular
 !~~~>  local PARAMETERs
-   REAL(kind=dp),PARAMETER :: zero = 0.0_dp, one  = 1.0_dp
-   REAL(kind=dp),PARAMETER :: deltamin = 1.0e-5_dp
+   REAL(kind=dp), PARAMETER :: zero = 0.0_dp, one  = 1.0_dp
+   REAL(kind=dp), PARAMETER :: deltamin = 1.0e-5_dp
 !~~~>  locally called FUNCTIONs
 !    REAL(kind=dp) WLAMCH
@@ -1529,91 +1403,91 @@
    t = tstart
    rstatus(nhexit) = zero
-   h = min( max(abs(hmin),abs(hstart)),abs(hmax))
-   IF (abs(h)<= 10.0_dp*roundoff)h = deltamin
-
-   IF (tEND  >=  tstart)THEN
+   h = min( max(abs(hmin), abs(hstart)), abs(hmax))
+   IF (abs(h)<= 10.0_dp* roundoff)h = deltamin
+
+   IF (tend  >=  tstart)THEN
      direction = + 1
    ELSE
      direction = - 1
    ENDIF
-   h = direction*h
-
-   rejectlasth=.false.
-   rejectmoreh=.false.
+   h = direction* h
+
+   rejectlasth=.FALSE.
+   rejectmoreh=.FALSE.
 
 !~~~> time loop begins below
 
-timeloop: DO WHILE((direction > 0).and.((t- tEND)+ roundoff <= zero)&
-       .or. (direction < 0).and.((tend-t)+ roundoff <= zero))
-
-   IF(istatus(nstp)> max_no_steps)THEN  ! too many steps
-      CALL ros_errormsg(- 6,t,h,ierr)
+timeloop: DO WHILE((direction > 0).and.((t- tend) + roundoff <= zero)&
+       .or. (direction < 0).and.((tend-t) + roundoff <= zero))
+
+   IF (istatus(nstp)> max_no_steps)THEN  ! too many steps
+      CALL ros_errormsg(- 6, t, h, ierr)
       RETURN
    ENDIF
-   IF(((t+ 0.1_dp*h) == t).or.(h <= roundoff))THEN  ! step size too small
-      CALL ros_errormsg(- 7,t,h,ierr)
+   IF (((t+ 0.1_dp* h) == t).or.(h <= roundoff))THEN  ! step size too small
+      CALL ros_errormsg(- 7, t, h, ierr)
       RETURN
    ENDIF
 
 !~~~>  limit h IF necessary to avoid going beyond tend
-   h = min(h,abs(tend-t))
+   h = min(h, abs(tend-t))
 
 !~~~>   compute the FUNCTION at current time
-   CALL funtemplate(t,y,fcn0)
-   istatus(nfun) = istatus(nfun)+ 1
+   CALL funtemplate(t, y, fcn0)
+   istatus(nfun) = istatus(nfun) + 1
 
 !~~~>  compute the FUNCTION derivative with respect to t
    IF (.not.autonomous)THEN
-      CALL ros_funtimederivative(t,roundoff,y,&
-                fcn0,dfdt)
+      CALL ros_funtimederivative(t, roundoff, y, &
+                fcn0, dfdt)
    ENDIF
 
 !~~~>   compute the jacobian at current time
-   CALL jactemplate(t,y,jac0)
-   istatus(njac) = istatus(njac)+ 1
+   CALL jactemplate(t, y, jac0)
+   istatus(njac) = istatus(njac) + 1
 
 !~~~>  repeat step calculation until current step accepted
 untilaccepted: do
 
-   CALL ros_preparematrix(h,direction,ros_gamma(1),&
-          jac0,ghimj,pivot,singular)
+   CALL ros_preparematrix(h, direction, ros_gamma(1), &
+          jac0, ghimj, pivot, singular)
    IF (singular)THEN ! more than 5 consecutive failed decompositions
-       CALL ros_errormsg(- 8,t,h,ierr)
+       CALL ros_errormsg(- 8, t, h, ierr)
        RETURN
    ENDIF
 
 !~~~>   compute the stages
-stage: DO istage = 1,ros_s
+stage: DO istage = 1, ros_s
 
       ! current istage offset. current istage vector is k(ioffset+ 1:ioffset+ n)
-       ioffset = n*(istage-1)
+       ioffset = n* (istage-1)
 
       ! for the 1st istage the FUNCTION has been computed previously
-       IF(istage == 1)THEN
-         !slim: CALL wcopy(n,fcn0,1,fcn,1)
-	 fcn(1:n) = fcn0(1:n)
+       IF (istage == 1)THEN
+         !slim: CALL wcopy(n, fcn0, 1, fcn, 1)
+       fcn(1:n) = fcn0(1:n)
       ! istage>1 and a new FUNCTION evaluation is needed at the current istage
        ELSEIF(ros_newf(istage))THEN
-         !slim: CALL wcopy(n,y,1,ynew,1)
-	 ynew(1:n) = y(1:n)
-         DO j = 1,istage-1
-           CALL waxpy(n,ros_a((istage-1)*(istage-2)/2+ j),&
-            k(n*(j- 1)+ 1),1,ynew,1)
+         !slim: CALL wcopy(n, y, 1, ynew, 1)
+       ynew(1:n) = y(1:n)
+         DO j = 1, istage-1
+           CALL waxpy(n, ros_a((istage-1) * (istage-2) /2+ j), &
+            k(n* (j- 1) + 1), 1, ynew, 1)
          ENDDO
-         tau = t + ros_alpha(istage)*direction*h
-         CALL funtemplate(tau,ynew,fcn)
-         istatus(nfun) = istatus(nfun)+ 1
+         tau = t + ros_alpha(istage) * direction* h
+         CALL funtemplate(tau, ynew, fcn)
+         istatus(nfun) = istatus(nfun) + 1
        ENDIF ! IF istage == 1 ELSEIF ros_newf(istage)
-       !slim: CALL wcopy(n,fcn,1,k(ioffset+ 1),1)
+       !slim: CALL wcopy(n, fcn, 1, k(ioffset+ 1), 1)
        k(ioffset+ 1:ioffset+ n) = fcn(1:n)
-       DO j = 1,istage-1
-         hc = ros_c((istage-1)*(istage-2)/2+ j)/(direction*h)
-         CALL waxpy(n,hc,k(n*(j- 1)+ 1),1,k(ioffset+ 1),1)
+       DO j = 1, istage-1
+         hc = ros_c((istage-1) * (istage-2) /2+ j) /(direction* h)
+         CALL waxpy(n, hc, k(n* (j- 1) + 1), 1, k(ioffset+ 1), 1)
        ENDDO
        IF ((.not. autonomous).and.(ros_gamma(istage).ne.zero))THEN
-         hg = direction*h*ros_gamma(istage)
-         CALL waxpy(n,hg,dfdt,1,k(ioffset+ 1),1)
+         hg = direction* h* ros_gamma(istage)
+         CALL waxpy(n, hg, dfdt, 1, k(ioffset+ 1), 1)
        ENDIF
-       CALL ros_solve(ghimj,pivot,k(ioffset+ 1))
+       CALL ros_solve(ghimj, pivot, k(ioffset+ 1))
 
    END DO stage
@@ -1621,48 +1495,48 @@
 
 !~~~>  compute the new solution
-   !slim: CALL wcopy(n,y,1,ynew,1)
+   !slim: CALL wcopy(n, y, 1, ynew, 1)
    ynew(1:n) = y(1:n)
-   DO j=1,ros_s
-         CALL waxpy(n,ros_m(j),k(n*(j- 1)+ 1),1,ynew,1)
+   DO j=1, ros_s
+         CALL waxpy(n, ros_m(j), k(n* (j- 1) + 1), 1, ynew, 1)
    ENDDO
 
 !~~~>  compute the error estimation
-   !slim: CALL wscal(n,zero,yerr,1)
+   !slim: CALL wscal(n, zero, yerr, 1)
    yerr(1:n) = zero
-   DO j=1,ros_s
-        CALL waxpy(n,ros_e(j),k(n*(j- 1)+ 1),1,yerr,1)
+   DO j=1, ros_s
+        CALL waxpy(n, ros_e(j), k(n* (j- 1) + 1), 1, yerr, 1)
    ENDDO
-   err = ros_errornorm(y,ynew,yerr,abstol,reltol,vectortol)
+   err = ros_errornorm(y, ynew, yerr, abstol, reltol, vectortol)
 
 !~~~> new step size is bounded by facmin <= hnew/h <= facmax
-   fac  = min(facmax,max(facmin,facsafe/err**(one/ros_elo)))
-   hnew = h*fac
+   fac  = min(facmax, max(facmin, facsafe/err** (one/ros_elo)))
+   hnew = h* fac
 
 !~~~>  check the error magnitude and adjust step size
-   istatus(nstp) = istatus(nstp)+ 1
-   IF((err <= one).or.(h <= hmin))THEN  !~~~> accept step
-      istatus(nacc) = istatus(nacc)+ 1
-      !slim: CALL wcopy(n,ynew,1,y,1)
+   istatus(nstp) = istatus(nstp) + 1
+   IF ((err <= one).or.(h <= hmin))THEN  !~~~> accept step
+      istatus(nacc) = istatus(nacc) + 1
+      !slim: CALL wcopy(n, ynew, 1, y, 1)
       y(1:n) = ynew(1:n)
-      t = t + direction*h
-      hnew = max(hmin,min(hnew,hmax))
+      t = t + direction* h
+      hnew = max(hmin, min(hnew, hmax))
       IF (rejectlasth)THEN  ! no step size increase after a rejected step
-         hnew = min(hnew,h)
+         hnew = min(hnew, h)
       ENDIF
       rstatus(nhexit) = h
       rstatus(nhnew) = hnew
       rstatus(ntexit) = t
-      rejectlasth = .false.
-      rejectmoreh = .false.
+      rejectlasth = .FALSE.
+      rejectmoreh = .FALSE.
       h = hnew
       exit untilaccepted ! exit the loop: WHILE step not accepted
    ELSE           !~~~> reject step
       IF (rejectmoreh)THEN
-         hnew = h*facrej
+         hnew = h* facrej
       ENDIF
       rejectmoreh = rejectlasth
-      rejectlasth = .true.
+      rejectlasth = .TRUE.
       h = hnew
-      IF (istatus(nacc)>= 1) istatus(nrej) = istatus(nrej)+ 1
+      IF (istatus(nacc)>= 1) istatus(nrej) = istatus(nrej) + 1
    ENDIF ! err <= 1
 
@@ -1678,6 +1552,6 @@
 
 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  REAL(kind=dp)FUNCTION ros_errornorm(y,ynew,yerr,&
-                               abstol,reltol,vectortol)
+  REAL(kind=dp)FUNCTION ros_errornorm(y, ynew, yerr, &
+                               abstol, reltol, vectortol)
 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 !~~~> computes the "scaled norm" of the error vector yerr
@@ -1685,25 +1559,25 @@
 
 ! Input arguments
-   REAL(kind=dp),INTENT(in):: y(n),ynew(n),&
-          yerr(n),abstol(n),reltol(n)
-   LOGICAL,INTENT(in)::  vectortol
+   REAL(kind=dp), INTENT(IN):: y(n), ynew(n), &
+          yerr(n), abstol(n), reltol(n)
+   LOGICAL, INTENT(IN)::  vectortol
 ! Local variables
-   REAL(kind=dp):: err,scale,ymax
+   REAL(kind=dp):: err, scale, ymax
    INTEGER  :: i
-   REAL(kind=dp),PARAMETER :: zero = 0.0_dp
+   REAL(kind=dp), PARAMETER :: zero = 0.0_dp
 
    err = zero
-   DO i=1,n
-     ymax = max(abs(y(i)),abs(ynew(i)))
+   DO i=1, n
+     ymax = max(abs(y(i)), abs(ynew(i)))
      IF (vectortol)THEN
-       scale = abstol(i)+ reltol(i)*ymax
+       scale = abstol(i) + reltol(i) * ymax
      ELSE
-       scale = abstol(1)+ reltol(1)*ymax
+       scale = abstol(1) + reltol(1) * ymax
      ENDIF
-     err = err+(yerr(i)/scale)**2
+     err = err+ (yerr(i) /scale) ** 2
    ENDDO
    err  = sqrt(err/n)
 
-   ros_errornorm = max(err,1.0d-10)
+   ros_errornorm = max(err, 1.0d-10)
 
   END FUNCTION ros_errornorm
@@ -1711,6 +1585,6 @@
 
 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  SUBROUTINE ros_funtimederivative(t,roundoff,y,&
-                fcn0,dfdt)
+  SUBROUTINE ros_funtimederivative(t, roundoff, y, &
+                fcn0, dfdt)
 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 !~~~> the time partial derivative of the FUNCTION by finite differences
@@ -1718,16 +1592,16 @@
 
 !~~~> input arguments
-   REAL(kind=dp),INTENT(in):: t,roundoff,y(n),fcn0(n)
+   REAL(kind=dp), INTENT(IN):: t, roundoff, y(n), fcn0(n)
 !~~~> output arguments
-   REAL(kind=dp),INTENT(out):: dfdt(n)
+   REAL(kind=dp), INTENT(OUT):: dfdt(n)
 !~~~> local variables
    REAL(kind=dp):: delta
-   REAL(kind=dp),PARAMETER :: one = 1.0_dp, deltamin = 1.0e-6_dp
-
-   delta = sqrt(roundoff)*max(deltamin,abs(t))
-   CALL funtemplate(t+ delta,y,dfdt)
-   istatus(nfun) = istatus(nfun)+ 1
-   CALL waxpy(n,(- one),fcn0,1,dfdt,1)
-   CALL wscal(n,(one/delta),dfdt,1)
+   REAL(kind=dp), PARAMETER :: one = 1.0_dp, deltamin = 1.0e-6_dp
+
+   delta = sqrt(roundoff) * max(deltamin, abs(t))
+   CALL funtemplate(t+ delta, y, dfdt)
+   istatus(nfun) = istatus(nfun) + 1
+   CALL waxpy(n, (- one), fcn0, 1, dfdt, 1)
+   CALL wscal(n, (one/delta), dfdt, 1)
 
   END SUBROUTINE ros_funtimederivative
@@ -1735,6 +1609,6 @@
 
 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  SUBROUTINE ros_preparematrix(h,direction,gam,&
-             jac0,ghimj,pivot,singular)
+  SUBROUTINE ros_preparematrix(h, direction, gam, &
+             jac0, ghimj, pivot, singular)
 ! --- --- --- --- --- --- --- --- --- --- --- --- ---
 !  Prepares the LHS matrix for stage calculations
@@ -1748,61 +1622,61 @@
 !~~~> input arguments
 #ifdef full_algebra    
-   REAL(kind=dp),INTENT(in)::  jac0(n,n)
+   REAL(kind=dp), INTENT(IN)::  jac0(n, n)
 #else
-   REAL(kind=dp),INTENT(in)::  jac0(lu_nonzero)
+   REAL(kind=dp), INTENT(IN)::  jac0(lu_nonzero)
 #endif   
-   REAL(kind=dp),INTENT(in)::  gam
-   INTEGER,INTENT(in)::  direction
+   REAL(kind=dp), INTENT(IN)::  gam
+   INTEGER, INTENT(IN)::  direction
 !~~~> output arguments
 #ifdef full_algebra    
-   REAL(kind=dp),INTENT(out):: ghimj(n,n)
+   REAL(kind=dp), INTENT(OUT):: ghimj(n, n)
 #else
-   REAL(kind=dp),INTENT(out):: ghimj(lu_nonzero)
+   REAL(kind=dp), INTENT(OUT):: ghimj(lu_nonzero)
 #endif   
-   LOGICAL,INTENT(out)::  singular
-   INTEGER,INTENT(out)::  pivot(n)
+   LOGICAL, INTENT(OUT)::  singular
+   INTEGER, INTENT(OUT)::  pivot(n)
 !~~~> inout arguments
-   REAL(kind=dp),INTENT(inout):: h   ! step size is decreased when lu fails
+   REAL(kind=dp), INTENT(INOUT):: h   ! step size is decreased when lu fails
 !~~~> local variables
-   INTEGER  :: i,ising,nconsecutive
+   INTEGER  :: i, ising, nconsecutive
    REAL(kind=dp):: ghinv
-   REAL(kind=dp),PARAMETER :: one  = 1.0_dp, half = 0.5_dp
+   REAL(kind=dp), PARAMETER :: one  = 1.0_dp, half = 0.5_dp
 
    nconsecutive = 0
-   singular = .true.
+   singular = .TRUE.
 
    DO WHILE (singular)
 
-!~~~>    construct ghimj = 1/(h*gam)-  jac0
+!~~~>    construct ghimj = 1/(h* gam) - jac0
 #ifdef full_algebra    
-     !slim: CALL wcopy(n*n,jac0,1,ghimj,1)
-     !slim: CALL wscal(n*n,(- one),ghimj,1)
+     !slim: CALL wcopy(n* n, jac0, 1, ghimj, 1)
+     !slim: CALL wscal(n* n, (- one), ghimj, 1)
      ghimj = - jac0
-     ghinv = one/(direction*h*gam)
-     DO i=1,n
-       ghimj(i,i) = ghimj(i,i)+ ghinv
+     ghinv = one/(direction* h* gam)
+     DO i=1, n
+       ghimj(i, i) = ghimj(i, i) + ghinv
      ENDDO
 #else
-     !slim: CALL wcopy(lu_nonzero,jac0,1,ghimj,1)
-     !slim: CALL wscal(lu_nonzero,(- one),ghimj,1)
+     !slim: CALL wcopy(lu_nonzero, jac0, 1, ghimj, 1)
+     !slim: CALL wscal(lu_nonzero, (- one), ghimj, 1)
      ghimj(1:lu_nonzero) = - jac0(1:lu_nonzero)
-     ghinv = one/(direction*h*gam)
-     DO i=1,n
-       ghimj(lu_diag(i)) = ghimj(lu_diag(i))+ ghinv
+     ghinv = one/(direction* h* gam)
+     DO i=1, n
+       ghimj(lu_diag(i)) = ghimj(lu_diag(i)) + ghinv
      ENDDO
 #endif   
 !~~~>    compute lu decomposition
-     CALL ros_decomp( ghimj,pivot,ising)
+     CALL ros_decomp( ghimj, pivot, ising)
      IF (ising == 0)THEN
 !~~~>    IF successful done
-        singular = .false.
+        singular = .FALSE.
      ELSE ! ising .ne. 0
 !~~~>    IF unsuccessful half the step size; IF 5 consecutive fails THEN RETURN
-        istatus(nsng) = istatus(nsng)+ 1
+        istatus(nsng) = istatus(nsng) + 1
         nconsecutive = nconsecutive+1
-        singular = .true.
+        singular = .TRUE.
         PRINT*,'Warning: LU Decomposition returned ISING = ',ISING
         IF (nconsecutive <= 5)THEN ! less than 5 consecutive failed decompositions
-           h = h*half
+           h = h* half
         ELSE  ! more than 5 consecutive failed decompositions
            RETURN
@@ -1816,5 +1690,5 @@
 
 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  SUBROUTINE ros_decomp( a,pivot,ising)
+  SUBROUTINE ros_decomp( a, pivot, ising)
 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 !  Template for the LU decomposition
@@ -1822,18 +1696,18 @@
 !~~~> inout variables
 #ifdef full_algebra    
-   REAL(kind=dp),INTENT(inout):: a(n,n)
+   REAL(kind=dp), INTENT(INOUT):: a(n, n)
 #else   
-   REAL(kind=dp),INTENT(inout):: a(lu_nonzero)
+   REAL(kind=dp), INTENT(INOUT):: a(lu_nonzero)
 #endif
 !~~~> output variables
-   INTEGER,INTENT(out):: pivot(n),ising
+   INTEGER, INTENT(OUT):: pivot(n), ising
 
 #ifdef full_algebra    
-   CALL  dgetrf( n,n,a,n,pivot,ising)
+   CALL  dgetrf( n, n, a, n, pivot, ising)
 #else   
-   CALL kppdecomp(a,ising)
+   CALL kppdecomp(a, ising)
    pivot(1) = 1
 #endif
-   istatus(ndec) = istatus(ndec)+ 1
+   istatus(ndec) = istatus(ndec) + 1
 
   END SUBROUTINE ros_decomp
@@ -1841,5 +1715,5 @@
 
 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  SUBROUTINE ros_solve( a,pivot,b)
+  SUBROUTINE ros_solve( a, pivot, b)
 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 !  Template for the forward/backward substitution (using pre-computed LU decomposition)
@@ -1847,23 +1721,23 @@
 !~~~> input variables
 #ifdef full_algebra    
-   REAL(kind=dp),INTENT(in):: a(n,n)
+   REAL(kind=dp), INTENT(IN):: a(n, n)
    INTEGER :: ising
 #else   
-   REAL(kind=dp),INTENT(in):: a(lu_nonzero)
+   REAL(kind=dp), INTENT(IN):: a(lu_nonzero)
 #endif
-   INTEGER,INTENT(in):: pivot(n)
+   INTEGER, INTENT(IN):: pivot(n)
 !~~~> inout variables
-   REAL(kind=dp),INTENT(inout):: b(n)
+   REAL(kind=dp), INTENT(INOUT):: b(n)
 
 #ifdef full_algebra    
    CALL  DGETRS( 'N',N ,1,A,N,Pivot,b,N,ISING)
-   IF(info < 0)THEN
-      print*,"error in dgetrs. ising=",ising
+   IF (info < 0)THEN
+      print* , "error in dgetrs. ising=", ising
    ENDIF  
 #else   
-   CALL kppsolve( a,b)
+   CALL kppsolve( a, b)
 #endif
 
-   istatus(nsol) = istatus(nsol)+ 1
+   istatus(nsol) = istatus(nsol) + 1
 
   END SUBROUTINE ros_solve
@@ -1893,25 +1767,25 @@
 !       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
 
-    ros_a(1) = (1.0_dp)/g
-    ros_c(1) = (- 2.0_dp)/g
+    ros_a(1) = (1.0_dp) /g
+    ros_c(1) = (- 2.0_dp) /g
 !~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
 !   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
-    ros_newf(1) = .true.
-    ros_newf(2) = .true.
+    ros_newf(1) = .TRUE.
+    ros_newf(2) = .TRUE.
 !~~~> m_i = coefficients for new step solution
-    ros_m(1) = (3.0_dp)/(2.0_dp*g)
-    ros_m(2) = (1.0_dp)/(2.0_dp*g)
+    ros_m(1) = (3.0_dp) /(2.0_dp* g)
+    ros_m(2) = (1.0_dp) /(2.0_dp* g)
 ! E_i = Coefficients for error estimator
-    ros_e(1) = 1.0_dp/(2.0_dp*g)
-    ros_e(2) = 1.0_dp/(2.0_dp*g)
-!~~~> ros_elo = estimator of local order -  the minimum between the
+    ros_e(1) = 1.0_dp/(2.0_dp* g)
+    ros_e(2) = 1.0_dp/(2.0_dp* g)
+!~~~> ros_elo = estimator of local order - the minimum between the
 !    main and the embedded scheme orders plus one
     ros_elo = 2.0_dp
-!~~~> y_stage_i ~ y( t + h*alpha_i)
+!~~~> y_stage_i ~ y( t + h* alpha_i)
     ros_alpha(1) = 0.0_dp
     ros_alpha(2) = 1.0_dp
-!~~~> gamma_i = \sum_j  gamma_{i,j}
+!~~~> gamma_i = \sum_j  gamma_{i, j}
     ros_gamma(1) = g
-    ros_gamma(2) =- g
+    ros_gamma(2) = -g
 
  END SUBROUTINE ros2
@@ -1946,7 +1820,7 @@
 !~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
 !   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
-   ros_newf(1) = .true.
-   ros_newf(2) = .true.
-   ros_newf(3) = .false.
+   ros_newf(1) = .TRUE.
+   ros_newf(2) = .TRUE.
+   ros_newf(3) = .FALSE.
 !~~~> m_i = coefficients for new step solution
    ros_m(1) =  0.1e+01_dp
@@ -1957,12 +1831,12 @@
    ros_e(2) = - 0.29079558716805469821718236208017e+01_dp
    ros_e(3) =  0.22354069897811569627360909276199_dp
-!~~~> ros_elo = estimator of local order -  the minimum between the
+!~~~> ros_elo = estimator of local order - the minimum between the
 !    main and the embedded scheme orders plus 1
    ros_elo = 3.0_dp
-!~~~> y_stage_i ~ y( t + h*alpha_i)
+!~~~> y_stage_i ~ y( t + h* alpha_i)
    ros_alpha(1) = 0.0_dp
    ros_alpha(2) = 0.43586652150845899941601945119356_dp
    ros_alpha(3) = 0.43586652150845899941601945119356_dp
-!~~~> gamma_i = \sum_j  gamma_{i,j}
+!~~~> gamma_i = \sum_j  gamma_{i, j}
    ros_gamma(1) = 0.43586652150845899941601945119356_dp
    ros_gamma(2) = 0.24291996454816804366592249683314_dp
@@ -2007,16 +1881,16 @@
    ros_a(6) = 0.0_dp
 
-   ros_c(1) =- 0.7137615036412310e+01_dp
+   ros_c(1) = -0.7137615036412310e+01_dp
    ros_c(2) = 0.2580708087951457e+01_dp
    ros_c(3) = 0.6515950076447975_dp
-   ros_c(4) =- 0.2137148994382534e+01_dp
-   ros_c(5) =- 0.3214669691237626_dp
-   ros_c(6) =- 0.6949742501781779_dp
+   ros_c(4) = -0.2137148994382534e+01_dp
+   ros_c(5) = -0.3214669691237626_dp
+   ros_c(6) = -0.6949742501781779_dp
 !~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
 !   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
-   ros_newf(1) = .true.
-   ros_newf(2) = .true.
-   ros_newf(3) = .true.
-   ros_newf(4) = .false.
+   ros_newf(1) = .TRUE.
+   ros_newf(2) = .TRUE.
+   ros_newf(3) = .TRUE.
+   ros_newf(4) = .FALSE.
 !~~~> m_i = coefficients for new step solution
    ros_m(1) = 0.2255570073418735e+01_dp
@@ -2025,21 +1899,21 @@
    ros_m(4) = 0.1093502252409163e+01_dp
 !~~~> e_i  = coefficients for error estimator
-   ros_e(1) =- 0.2815431932141155_dp
-   ros_e(2) =- 0.7276199124938920e-01_dp
-   ros_e(3) =- 0.1082196201495311_dp
-   ros_e(4) =- 0.1093502252409163e+01_dp
-!~~~> ros_elo  = estimator of local order -  the minimum between the
+   ros_e(1) = -0.2815431932141155_dp
+   ros_e(2) = -0.7276199124938920e-01_dp
+   ros_e(3) = -0.1082196201495311_dp
+   ros_e(4) = -0.1093502252409163e+01_dp
+!~~~> ros_elo  = estimator of local order - the minimum between the
 !    main and the embedded scheme orders plus 1
    ros_elo  = 4.0_dp
-!~~~> y_stage_i ~ y( t + h*alpha_i)
+!~~~> y_stage_i ~ y( t + h* alpha_i)
    ros_alpha(1) = 0.0_dp
    ros_alpha(2) = 0.1145640000000000e+01_dp
    ros_alpha(3) = 0.6552168638155900_dp
    ros_alpha(4) = ros_alpha(3)
-!~~~> gamma_i = \sum_j  gamma_{i,j}
+!~~~> gamma_i = \sum_j  gamma_{i, j}
    ros_gamma(1) = 0.5728200000000000_dp
-   ros_gamma(2) =- 0.1769193891319233e+01_dp
+   ros_gamma(2) = -0.1769193891319233e+01_dp
    ros_gamma(3) = 0.7592633437920482_dp
-   ros_gamma(4) =- 0.1049021087100450_dp
+   ros_gamma(4) = -0.1049021087100450_dp
 
   END SUBROUTINE ros4
@@ -2074,15 +1948,15 @@
    ros_c(1) = 4.0_dp
    ros_c(2) = 1.0_dp
-   ros_c(3) =- 1.0_dp
+   ros_c(3) = -1.0_dp
    ros_c(4) = 1.0_dp
-   ros_c(5) =- 1.0_dp
-   ros_c(6) =- (8.0_dp/3.0_dp)
+   ros_c(5) = -1.0_dp
+   ros_c(6) = -(8.0_dp/3.0_dp)
 
 !~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
 !   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
-   ros_newf(1) = .true.
-   ros_newf(2) = .false.
-   ros_newf(3) = .true.
-   ros_newf(4) = .true.
+   ros_newf(1) = .TRUE.
+   ros_newf(2) = .FALSE.
+   ros_newf(3) = .TRUE.
+   ros_newf(4) = .TRUE.
 !~~~> m_i = coefficients for new step solution
    ros_m(1) = 2.0_dp
@@ -2095,13 +1969,13 @@
    ros_e(3) = 0.0_dp
    ros_e(4) = 1.0_dp
-!~~~> ros_elo  = estimator of local order -  the minimum between the
+!~~~> ros_elo  = estimator of local order - the minimum between the
 !    main and the embedded scheme orders plus 1
    ros_elo  = 3.0_dp
-!~~~> y_stage_i ~ y( t + h*alpha_i)
+!~~~> y_stage_i ~ y( t + h* alpha_i)
    ros_alpha(1) = 0.0_dp
    ros_alpha(2) = 0.0_dp
    ros_alpha(3) = 1.0_dp
    ros_alpha(4) = 1.0_dp
-!~~~> gamma_i = \sum_j  gamma_{i,j}
+!~~~> gamma_i = \sum_j  gamma_{i, j}
    ros_gamma(1) = 0.5_dp
    ros_gamma(2) = 1.5_dp
@@ -2129,5 +2003,5 @@
     ros_s = 6
 
-!~~~> y_stage_i ~ y( t + h*alpha_i)
+!~~~> y_stage_i ~ y( t + h* alpha_i)
     ros_alpha(1) = 0.000_dp
     ros_alpha(2) = 0.386_dp
@@ -2137,9 +2011,9 @@
     ros_alpha(6) = 1.000_dp
 
-!~~~> gamma_i = \sum_j  gamma_{i,j}
+!~~~> gamma_i = \sum_j  gamma_{i, j}
     ros_gamma(1) = 0.2500000000000000_dp
-    ros_gamma(2) =- 0.1043000000000000_dp
+    ros_gamma(2) = -0.1043000000000000_dp
     ros_gamma(3) = 0.1035000000000000_dp
-    ros_gamma(4) =- 0.3620000000000023e-01_dp
+    ros_gamma(4) = -0.3620000000000023e-01_dp
     ros_gamma(5) = 0.0_dp
     ros_gamma(6) = 0.0_dp
@@ -2160,5 +2034,5 @@
     ros_a(8) = 0.6019134481288629e+01_dp
     ros_a(9) = 0.1253708332932087e+02_dp
-    ros_a(10) =- 0.6878860361058950_dp
+    ros_a(10) = -0.6878860361058950_dp
     ros_a(11) = ros_a(7)
     ros_a(12) = ros_a(8)
@@ -2167,19 +2041,19 @@
     ros_a(15) = 1.0_dp
 
-    ros_c(1) =- 0.5668800000000000e+01_dp
-    ros_c(2) =- 0.2430093356833875e+01_dp
-    ros_c(3) =- 0.2063599157091915_dp
-    ros_c(4) =- 0.1073529058151375_dp
-    ros_c(5) =- 0.9594562251023355e+01_dp
-    ros_c(6) =- 0.2047028614809616e+02_dp
+    ros_c(1) = -0.5668800000000000e+01_dp
+    ros_c(2) = -0.2430093356833875e+01_dp
+    ros_c(3) = -0.2063599157091915_dp
+    ros_c(4) = -0.1073529058151375_dp
+    ros_c(5) = -0.9594562251023355e+01_dp
+    ros_c(6) = -0.2047028614809616e+02_dp
     ros_c(7) = 0.7496443313967647e+01_dp
-    ros_c(8) =- 0.1024680431464352e+02_dp
-    ros_c(9) =- 0.3399990352819905e+02_dp
+    ros_c(8) = -0.1024680431464352e+02_dp
+    ros_c(9) = -0.3399990352819905e+02_dp
     ros_c(10) = 0.1170890893206160e+02_dp
     ros_c(11) = 0.8083246795921522e+01_dp
-    ros_c(12) =- 0.7981132988064893e+01_dp
-    ros_c(13) =- 0.3152159432874371e+02_dp
+    ros_c(12) = -0.7981132988064893e+01_dp
+    ros_c(13) = -0.3152159432874371e+02_dp
     ros_c(14) = 0.1631930543123136e+02_dp
-    ros_c(15) =- 0.6058818238834054e+01_dp
+    ros_c(15) = -0.6058818238834054e+01_dp
 
 !~~~> m_i = coefficients for new step solution
@@ -2201,12 +2075,12 @@
 !~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
 !   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
-    ros_newf(1) = .true.
-    ros_newf(2) = .true.
-    ros_newf(3) = .true.
-    ros_newf(4) = .true.
-    ros_newf(5) = .true.
-    ros_newf(6) = .true.
-
-!~~~> ros_elo  = estimator of local order -  the minimum between the
+    ros_newf(1) = .TRUE.
+    ros_newf(2) = .TRUE.
+    ros_newf(3) = .TRUE.
+    ros_newf(4) = .TRUE.
+    ros_newf(5) = .TRUE.
+    ros_newf(6) = .TRUE.
+
+!~~~> ros_elo  = estimator of local order - the minimum between the
 !        main and the embedded scheme orders plus 1
     ros_elo = 4.0_dp
@@ -2271,10 +2145,10 @@
 !~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
 !   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
-    ros_newf(1) = .true.
-    ros_newf(2) = .true.
-    ros_newf(3) = .true.
-    ros_newf(4) = .true.
-
-!~~~> ros_elo  = estimator of local order -  the minimum between the
+    ros_newf(1) = .TRUE.
+    ros_newf(2) = .TRUE.
+    ros_newf(3) = .TRUE.
+    ros_newf(4) = .TRUE.
+
+!~~~> ros_elo  = estimator of local order - the minimum between the
 !        main and the embedded scheme orders plus 1
     ros_elo = 3.0_dp
@@ -2288,5 +2162,5 @@
 END SUBROUTINE rosenbrock
  
-SUBROUTINE funtemplate( t,y,ydot)
+SUBROUTINE funtemplate( t, y, ydot)
 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 !  Template for the ODE function call.
@@ -2294,5 +2168,5 @@
 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 !~~~> input variables
-   REAL(kind=dp):: t,y(nvar)
+   REAL(kind=dp):: t, y(nvar)
 !~~~> output variables
    REAL(kind=dp):: ydot(nvar)
@@ -2302,10 +2176,10 @@
    told = time
    time = t
-   CALL fun( y,fix,rconst,ydot)
+   CALL fun( y, fix, rconst, ydot)
    time = told
 
 END SUBROUTINE funtemplate
  
-SUBROUTINE jactemplate( t,y,jcb)
+SUBROUTINE jactemplate( t, y, jcb)
 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 !  Template for the ODE Jacobian call.
@@ -2313,8 +2187,8 @@
 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 !~~~> input variables
-    REAL(kind=dp):: t,y(nvar)
+    REAL(kind=dp):: t, y(nvar)
 !~~~> output variables
 #ifdef full_algebra    
-    REAL(kind=dp):: jv(lu_nonzero),jcb(nvar,nvar)
+    REAL(kind=dp):: jv(lu_nonzero), jcb(nvar, nvar)
 #else
     REAL(kind=dp):: jcb(lu_nonzero)
@@ -2323,5 +2197,5 @@
     REAL(kind=dp):: told
 #ifdef full_algebra    
-    INTEGER :: i,j
+    INTEGER :: i, j
 #endif   
 
@@ -2329,15 +2203,15 @@
     time = t
 #ifdef full_algebra    
-    CALL jac_sp(y,fix,rconst,jv)
-    DO j=1,nvar
-      DO i=1,nvar
-         jcb(i,j) = 0.0_dp
+    CALL jac_sp(y, fix, rconst, jv)
+    DO j=1, nvar
+      DO i=1, nvar
+         jcb(i, j) = 0.0_dp
       ENDDO
     ENDDO
-    DO i=1,lu_nonzero
-       jcb(lu_irow(i),lu_icol(i)) = jv(i)
+    DO i=1, lu_nonzero
+       jcb(lu_irow(i), lu_icol(i)) = jv(i)
     ENDDO
 #else
-    CALL jac_sp( y,fix,rconst,jcb)
+    CALL jac_sp( y, fix, rconst, jcb)
 #endif   
     time = told
@@ -2345,37 +2219,74 @@
 END SUBROUTINE jactemplate
  
-SUBROUTINE chem_gasphase_integrate (time_step_len,conc,tempk,photo,ierrf,xnacc,xnrej,istatus,l_debug,pe) 
+  SUBROUTINE kppdecomp( jvs, ier)                                    
+  ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
+  !        sparse lu factorization                                    
+  ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
+  ! loop expansion generated by kp4                                   
+                                                                      
+    INTEGER  :: ier                                                   
+    REAL(kind=dp):: jvs(lu_nonzero), w(nvar), a             
+    INTEGER  :: k, kk, j, jj                                          
+                                                                      
+    a = 0.                                                            
+    ier = 0                                                           
+                                                                      
+!   i = 1
+!   i = 2
+    RETURN                                                            
+                                                                      
+  END SUBROUTINE kppdecomp                                            
+ 
+SUBROUTINE chem_gasphase_integrate (time_step_len, conc, tempi, qvapi, fakti, photo, ierrf, xnacc, xnrej, istatus, l_debug, pe, &
+                     icntrl_i, rcntrl_i) 
                                                                     
   IMPLICIT NONE                                                     
                                                                     
-  REAL(dp), INTENT(IN)                    :: time_step_len           
-  REAL(dp), DIMENSION(:,:), INTENT(INOUT) :: conc                    
-  REAL(dp), DIMENSION(:,:), INTENT(INOUT) :: photo                   
-  REAL(dp), DIMENSION(:), INTENT(IN)      :: tempk                   
-  INTEGER, INTENT(OUT), OPTIONAL          :: ierrf(:)                
-  INTEGER, INTENT(OUT), OPTIONAL          :: xnacc(:)                
-  INTEGER, INTENT(OUT), OPTIONAL          :: xnrej(:)                
-  INTEGER, INTENT(INOUT), OPTIONAL        :: istatus(:)              
-  INTEGER, INTENT(IN), OPTIONAL           :: pe                      
-  LOGICAL, INTENT(IN), OPTIONAL           :: l_debug                 
+  REAL(dp), INTENT(IN)                  :: time_step_len           
+  REAL(dp), DIMENSION(:, :), INTENT(INOUT) :: conc                    
+  REAL(dp), DIMENSION(:, :), INTENT(IN)   :: photo                   
+  REAL(dp), DIMENSION(:), INTENT(IN)     :: tempi                   
+  REAL(dp), DIMENSION(:), INTENT(IN)     :: qvapi                   
+  REAL(dp), DIMENSION(:), INTENT(IN)     :: fakti                   
+  INTEGER, INTENT(OUT), OPTIONAL        :: ierrf(:)               
+  INTEGER, INTENT(OUT), OPTIONAL        :: xnacc(:)               
+  INTEGER, INTENT(OUT), OPTIONAL        :: xnrej(:)               
+  INTEGER, INTENT(INOUT), OPTIONAL      :: istatus(:)             
+  INTEGER, INTENT(IN), OPTIONAL         :: pe                      
+  LOGICAL, INTENT(IN), OPTIONAL         :: l_debug                 
+  INTEGER, DIMENSION(nkppctrl), INTENT(IN), OPTIONAL  :: icntrl_i         
+  REAL(dp), DIMENSION(nkppctrl), INTENT(IN), OPTIONAL  :: rcntrl_i         
                                                                     
   INTEGER                                 :: k   ! loop variable     
-  REAL(dp)                                :: dt                      
-  INTEGER, DIMENSION(20)                  :: istatus_u               
-  INTEGER                                 :: ierr_u                  
-                                                                    
-                                                                    
-  if (present (istatus)) istatus = 0                              
-                                                                    
-  DO k=1,vl_glo,vl_dim                                              
+  REAL(dp)                               :: dt                      
+  INTEGER, DIMENSION(20)                :: istatus_u               
+  INTEGER                                :: ierr_u                  
+  INTEGER                                :: istatf                  
+  INTEGER                                :: vl_dim_lo               
+                                                                    
+                                                                    
+  IF (PRESENT (istatus)) istatus = 0                             
+  IF (PRESENT (icntrl_i)) icntrl  = icntrl_i                      
+  IF (PRESENT (rcntrl_i)) rcntrl  = rcntrl_i                      
+                                                                    
+  vl_glo = size(tempi, 1)                                           
+                                                                    
+  vl_dim_lo = vl_dim                                                
+  DO k=1, vl_glo, vl_dim_lo                                           
     is = k                                                          
-    ie = min(k+vl_dim-1,vl_glo)                                     
-    vl = ie-is+1                                                    
-                                                                    
-    c(:) = conc(is,:)                                             
-                                                                    
-    temp = tempk(is)                                              
-                                                                    
-    phot(:) = photo(is,:)                                             
+    ie = min(k+ vl_dim_lo-1, vl_glo)                                 
+    vl = ie-is+ 1                                                    
+                                                                    
+    c(:) = conc(is, :)                                            
+                                                                    
+    temp = tempi(is)                                             
+                                                                    
+    qvap = qvapi(is)                                             
+                                                                    
+    fakt = fakti(is)                                             
+                                                                    
+    CALL initialize                                                 
+                                                                    
+    phot(:) = photo(is, :)                                            
                                                                     
     CALL update_rconst                                              
@@ -2384,20 +2295,21 @@
                                                                     
     ! integrate from t=0 to t=dt                                    
-    CALL integrate(0._dp, dt,icntrl,rcntrl,istatus_u = istatus_u,ierr_u=ierr_u)
-                                                                    
-                                                                    
-    IF (PRESENT(l_debug) .AND. PRESENT(pe)) THEN                       
-       IF (l_debug) CALL error_output(conc(is,:),ierr_u,pe)           
-    ENDIF                                                              
-    conc(is,:) = c(:)                                                  
-                                                                    
-    ! Return Diagnostic Information                                 
-                                                                    
-    if(PRESENT(ierrf))    ierrf(is) = ierr_u                      
-    if(PRESENT(xnacc))    xnacc(is) = istatus_u(4)                
-    if(PRESENT(xnrej))    xnrej(is) = istatus_u(5)                
-                                                                    
-    if (PRESENT (istatus)) then                                   
-      istatus(1:8) = istatus(1:8) + istatus_u(1:8)                 
+    CALL integrate(0._dp, dt, icntrl, rcntrl, istatus_u = istatus_u, ierr_u=ierr_u)
+                                                                    
+                                                                    
+   IF (PRESENT(l_debug) .AND. PRESENT(pe)) THEN                       
+      IF (l_debug) CALL error_output(conc(is, :), ierr_u, pe)          
+   ENDIF                                                              
+                                                                      
+    conc(is, :) = c(:)                                                
+                                                                    
+    ! RETURN diagnostic information                                 
+                                                                    
+    IF (PRESENT(ierrf))   ierrf(is) = ierr_u                      
+    IF (PRESENT(xnacc))   xnacc(is) = istatus_u(4)               
+    IF (PRESENT(xnrej))   xnrej(is) = istatus_u(5)               
+                                                                    
+    IF (PRESENT (istatus)) THEN                                   
+      istatus(1:8) = istatus(1:8) + istatus_u(1:8)                
     ENDIF                                                          
                                                                     
@@ -2407,32 +2319,9 @@
 ! Deallocate input arrays                                           
                                                                     
-  if (ALLOCATED(temp))   DEALLOCATE(temp)   
-                                                                    
-  data_loaded = .false.                                             
+                                                                    
+  data_loaded = .FALSE.                                             
                                                                     
   RETURN                                                            
 END SUBROUTINE chem_gasphase_integrate                                        
- 
-  SUBROUTINE fill_temp(status,array) 
- 
-    INTEGER, INTENT(OUT)               :: status 
-    REAL(dp), INTENT(IN), DIMENSION(:) :: array 
- 
-    status = 0
-    IF (.not. ALLOCATED(temp)) & 
-       ALLOCATE(temp(size(array))) 
- 
-    IF (data_loaded .AND. (vl_glo /= size(array,1))) THEN 
-       status = 1 
-       RETURN 
-    END IF 
- 
-    vl_glo = size(array,1) 
-    temp = array 
-    data_loaded = .TRUE. 
- 
-    RETURN
- 
-  END   SUBROUTINE fill_temp
 
 END MODULE chem_gasphase_mod
Index: palm/trunk/SOURCE/chem_modules.f90
===================================================================
--- palm/trunk/SOURCE/chem_modules.f90	(revision 3297)
+++ palm/trunk/SOURCE/chem_modules.f90	(revision 3298)
@@ -15,7 +15,7 @@
 ! PALM. If not, see <http://www.gnu.org/licenses/>.
 !
-! Copyright 1997-2018 Leibniz Universitaet Hannover
-! Copyright 2017-2018 Karlsruhe Institute of Technology
-! Copyright 2017-2018 Freie Universitaet Berlin
+! Copyright 2018-2018 Leibniz Universitaet Hannover
+! Copyright 2018-2018 Karlsruhe Institute of Technology
+! Copyright 2018-2018 Freie Universitaet Berlin
 !------------------------------------------------------------------------------!
 !
@@ -27,7 +27,11 @@
 ! -----------------
 ! $Id$
-! Removed preprocessor directive __chem
+! - Minor formatting
+! - Introduced Variables for Chemistry emissions Module (Russo)
+! - Variables and parameters added for 2d and profile output (basit)
+! - Converted scalar  emission factors  to 1-D array of 99 elements each (basit)
+! - Removed "__chem" directive (basit)
 ! 
-! 2718 2018-01-02 08:49:38Z maronga
+! 3282 2018-09-27 10:49:12Z basit
 ! Initial revision
 !
@@ -49,7 +53,14 @@
  MODULE chem_modules
 
-    USE kinds 
     USE chem_gasphase_mod,                                                     &   
         ONLY: nspec, nvar, spc_names
+
+    USE control_parameters,                                                    &
+        ONLY: varnamelength
+
+    USE kinds
+
+    USE statistics,                                                            &
+        ONLY: pr_palm
 
 
@@ -60,76 +71,95 @@
     PUBLIC spc_names
 
-    LOGICAL ::  constant_top_csflux(99)            = .TRUE.                       !< chem spcs at the top  orig .TRUE.
-    LOGICAL ::  constant_csflux(99)                = .TRUE.                       !< chem spcs at namelist parameter   orig TRUE
+    INTEGER(iwp), DIMENSION(99)  :: cs_pr_index            = 0
+    INTEGER(iwp)  :: ibc_cs_b                                                      !< integer flag for bc_cs_b
+    INTEGER(iwp)  :: ibc_cs_t                                                      !< integer flag for bc_cs_t
+    INTEGER(iwp)  :: cs_pr_count                           = 0 
+    INTEGER(iwp)  :: max_pr_cs                             = 0
+    INTEGER(iwp)  :: cs_vertical_gradient_level_ind(99,10) = -9999                 !< grid index values of cs_vertical_gradient_level_ind(s)
+
+    LOGICAL       :: constant_top_csflux(99)               = .TRUE.                !< chem spcs at the top  orig .TRUE.
+    LOGICAL       :: constant_csflux(99)                   = .TRUE.                !< chem spcs at namelist parameter   orig TRUE
+    LOGICAL       :: call_chem_at_all_substeps             = .FALSE.               !< namelist parameter 
+    LOGICAL       :: chem_debug0                           = .FALSE.               !< namelist parameter flag for minimum print output
+    LOGICAL       :: chem_debug1                           = .FALSE.               !< namelist parameter flag for print output
+    LOGICAL       :: chem_debug2                           = .FALSE.               !< namelist parameter flag for further print output
+    LOGICAL       :: chem_gasphase_on                      = .TRUE.                !< namelist parameter 
+    LOGICAL       :: emission_output_required              = .TRUE.                !< Logical Variable for requiring Emission Outputs
+    LOGICAL       :: do_emis                               = .FALSE.               !< Flag for turning on chemistry emissions 
+    LOGICAL       :: cs_pr_namelist_found                  = .FALSE.               !< Namelist parameter: Names of t
 
 
-    INTEGER(iwp) :: cs_vertical_gradient_level_ind(99,10) = -9999                 !< grid index values of cs_vertical_gradient_level_ind(s)
-    REAL(wp),     DIMENSION(:),   ALLOCATABLE :: bc_cs_t_val
-    INTEGER(iwp)                              :: ibc_cs_b                         !< integer flag for bc_cs_b
-    INTEGER(iwp)                              :: ibc_cs_t                         !< integer flag for bc_cs_t
-
-    REAL(wp),      DIMENSION(:),  ALLOCATABLE ::  css                             !< scaling parameter for chem spcs
 
 !-- Namelist parameters for creating initial chemistry profiles
-    CHARACTER (LEN=20)               :: bc_cs_b    = 'dirichlet'                  !< namelist parameter
-    CHARACTER (LEN=20)               :: bc_cs_t    = 'initial_gradient'           !< namelist parameter
-    REAL(wp) :: wall_csflux (99,0:5)               = 0.0_wp                       !< namelist parameter
-    REAL(wp) :: cs_vertical_gradient (99,10)       = 0.0_wp                       !< namelist parameter
-    REAL(wp) :: cs_vertical_gradient_level (99,10) = -999999.9_wp                 !< namelist parameter
-    REAL(wp) :: top_csflux ( 99 )                  = 0.0_wp                       !< namelist parameter 
-    REAL(wp) :: cs_surface_initial_change(99)      = 0.0_wp                       !< namelist parameter
-    REAL(wp) :: surface_csflux(99 )                = 0.0_wp                       !< namelist parameter: fluxes where 'surface_csflux_name' is in the namelist
-!   RFo: I do not know whether it makes sense to have 'constant_csflux=.TRUE. for only these species where 
-!        no flux is given in the namelist. Let's choos surface_csflux=0.0 (and thus 'constant_csflux'=.TRUE.) as default
-!       To obtain  constant_csflux=.FALSE., set surface_csflux = 9999999.9 in the namelist
-!   @todo: need to think a bit more about constant_csflux for chemistry. 
+    REAL(wp) :: wall_csflux (99,0:5)               = 0.0_wp                        !< namelist parameter
+    REAL(wp) :: cs_vertical_gradient (99,10)       = 0.0_wp                        !< namelist parameter
+    REAL(wp) :: cs_vertical_gradient_level (99,10) = -999999.9_wp                  !< namelist parameter
+    REAL(wp) :: top_csflux ( 99 )                  = 0.0_wp                        !< namelist parameter 
+    REAL(wp) :: cs_surface_initial_change(99)      = 0.0_wp                        !< namelist parameter
+    REAL(wp) :: surface_csflux(99 )                = 0.0_wp                        !< namelist parameter: fluxes where 'surface_csflux_name' is in the namelist
 
-    LOGICAL :: call_chem_at_all_substeps           = .FALSE.                      !< namelist parameter 
-    LOGICAL :: chem_debug0                         = .FALSE.                      !< namelist parameter flag for minimum print output
-    LOGICAL :: chem_debug1                         = .FALSE.                      !< namelist parameter flag for print output
-    LOGICAL :: chem_debug2                         = .FALSE.                      !< namelist parameter flag for further print output
-    LOGICAL :: chem_gasphase_on                    = .TRUE.                       !< namelist parameter 
+    REAL(wp), DIMENSION(:),  ALLOCATABLE              :: bc_cs_t_val
+    REAL(wp), DIMENSION(:),  ALLOCATABLE              ::  css                      !< scaling parameter for chem spcs
+    REAL(wp), DIMENSION(99)                           :: cs_surface = 0.0_wp       !< Namelist parameter: Surface conc of chem spcs'
+    REAL(wp), DIMENSION(99,100)                       :: cs_heights = 9999999.9_wp !< Namelist parameter: Height lvls(m) for cs_profiles
+    REAL(wp), DIMENSION(99,100)                       :: cs_profile = 9999999.9_wp !< Namelist parameter: Chem conc for each spcs defined
 
-    CHARACTER (LEN=11), DIMENSION(99)         :: cs_name = 'novalue'              !< Namelist parameter: chem spcs names 
-    CHARACTER (LEN=11), DIMENSION(99)         :: cs_profile_name = 'novalue'      !< Namelist parameter: Names of the
-    CHARACTER (LEN=11), DIMENSION(99)         :: surface_csflux_name = 'novalue'  !< Namelist parameter: chem species surface fluxes names
-                                                                                  !< active chem spcs, default is 'novalue')  ????
-    REAL(wp), DIMENSION(99)                   :: cs_surface = 0.0_wp              !< Namelist parameter: Surface conc of chem spcs'
-    REAL(wp), DIMENSION(99,100)               :: cs_heights = 9999999.9_wp        !< Namelist parameter: Height lvls(m) for cs_profiles
-    REAL(wp), DIMENSION(99,100)               :: cs_profile = 9999999.9_wp        !< Namelist parameter: Chem conc for each spcs defined
 
 #if defined( __nopointer )
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET   :: cs                       !< chem spcs
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET   :: cs_p                     !< prognostic value of chem spc
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET   :: tcs_m                    !< weighted tendency of s for previous sub-timestep (Runge-Kutta)
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET   :: cs                        !< chem spcs
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET   :: cs_p                      !< prognostic value of chem spc
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET   :: tcs_m                     !< weighted tendency of cs for previous sub-timestep (Runge-Kutta)
 
 #else                                                               
 ! use pointers cs, cs_p and tcs_m to point arrays cs_1, cs_2, and cs_3
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: cs_1                     !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: cs_2                     !< pointer for swapping of timelevels for respective quantity
-    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: cs_3                     !< pointer for swapping of timelevels for respective quantity
-
-    REAL(wp), DIMENSION(:,:,:), POINTER               :: cs                       !< pointer: sgs chem spcs)
-    REAL(wp), DIMENSION(:,:,:), POINTER               :: cs_p                     !< pointer: prognostic value of sgs chem spcs 
-    REAL(wp), DIMENSION(:,:,:), POINTER               :: tcs_m                    !< pointer:
+    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: cs_1                      !< pointer for swapping of timelevels for respective quantity
+    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: cs_2                      !< pointer for swapping of timelevels for respective quantity
+    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: cs_3                      !< pointer for swapping of timelevels for respective quantity
+    REAL(wp), DIMENSION(:,:,:), POINTER               :: cs                        !< pointer: sgs chem spcs)
+    REAL(wp), DIMENSION(:,:,:), POINTER               :: cs_p                      !< pointer: prognostic value of sgs chem spcs 
+    REAL(wp), DIMENSION(:,:,:), POINTER               :: tcs_m                     !< pointer:
 
 #endif                                                                            
-                                                                                  !< by cs_name for each height lvls defined by cs_heights
+ 
+    CHARACTER (LEN=20)                 :: bc_cs_b             = 'dirichlet'        !< namelist parameter
+    CHARACTER (LEN=20)                 :: bc_cs_t             = 'initial_gradient' !< namelist parameter
+    CHARACTER (LEN=11), DIMENSION(99)  :: cs_name             = 'novalue'          !< Namelist parameter: chem spcs names 
+    CHARACTER (LEN=11), DIMENSION(99)  :: cs_profile_name     = 'novalue'          !< Namelist parameter: Names of the chem for profiles
+    CHARACTER (LEN=11), DIMENSION(99)  :: surface_csflux_name = 'novalue'          !< Namelist parameter: chem species surface fluxes names
+                                                                                   !< active chem spcs, default is 'novalue')  ????
+    CHARACTER (LEN=80)                 :: mode_emis           ='PARAMETERIZED'     !< Mode of chemistry emissions: DEFAULT .OR. EXPERT .OR. 
+                                                                                   !  PARAMETERIZED
+    CHARACTER (LEN=80)                 :: time_fac_type       ='MDH'               !< Type of time treatment in the emis DEFAULT mode: HOUR .OR. MDH 
+    CHARACTER (LEN=80)                 :: daytype_mdh         ='workday'           !< Type of day in the MDH case: workday, weekend, holiday
+    CHARACTER (LEN=11), DIMENSION(99)  :: data_output_pr_cs   = 'novalue'          !< Namelist parameter: Names of the che    m for profile output
+                                                                                   !< by cs_name for each height lvls defined by cs_heights
 !
 !-- Namelist parameters for chem_emissions
     INTEGER(iwp) ::  main_street_id = 0
-    INTEGER(iwp) ::  max_street_id = 0
+    INTEGER(iwp) ::  max_street_id  = 0
     INTEGER(iwp) ::  side_street_id = 0
 !
 !-- Constant emission factors
-    REAL(wp) ::  emiss_factor_main = 0.0_wp
-    REAL(wp) ::  emiss_factor_side = 0.0_wp
+    REAL(wp) ::  emiss_factor_main ( 99 ) = -9999.0_wp
+    REAL(wp) ::  emiss_factor_side ( 99 ) = -9999.0_wp
     
-!-- Emission factors with daily cycle
-!     REAL(wp), DIMENSION(1:24) ::  emiss_factor_main = 0.0_wp
-!     REAL(wp), DIMENSION(1:24) ::  emiss_factor_side = 0.0_wp
+!-- Other Emissions Variables
+    INTEGER(iwp) ::  nspec_out                                                     !< Output of routine chem_emis_matching with 
+                                                                                   !< number of matched species
+    REAL(wp),ALLOCATABLE, DIMENSION(:,:,:,:)         :: emis_distribution          !> Emissions Final Values (main module output)
+
+    INTEGER(iwp),ALLOCATABLE,DIMENSION(:)            :: match_spec_input           !< Index of Input chem species for matching routine 
+    INTEGER(iwp),ALLOCATABLE,DIMENSION(:)            :: match_spec_model           !< Index of Model chem species for matching routine
+    INTEGER(iwp),ALLOCATABLE,DIMENSION(:)            :: match_spec_voc_input       !< index of VOC input components matching the model's VOCs
+    INTEGER(iwp),ALLOCATABLE,DIMENSION(:)            :: match_spec_voc_model       !< index of VOC model species matching the input VOCs comp.
+    INTEGER(iwp),DIMENSION(:)                        :: match_spec_pm(1:3)         !< results of matching the input and model's PMs
+    INTEGER(iwp),DIMENSION(:)                        :: match_spec_nox(1:2)        !< results of matching the input and model's NOx
+    INTEGER(iwp),DIMENSION(:)                        :: match_spec_sox(1:2)        !< results of matching the input and model's SOx! 
+                                                                                   ! TBD: evaluate whether to make them allocatable 
+                                                                                   ! and allocate their dimension in the matching 
+                                                                                   ! routine according to the number of components 
+                                                                                   ! matching between the model and the input files
 
     SAVE
-
  END MODULE chem_modules
 
Index: palm/trunk/SOURCE/chem_photolysis_mod.f90
===================================================================
--- palm/trunk/SOURCE/chem_photolysis_mod.f90	(revision 3297)
+++ palm/trunk/SOURCE/chem_photolysis_mod.f90	(revision 3298)
@@ -15,6 +15,6 @@
 ! PALM. If not, see <http://www.gnu.org/licenses/>.
 !
-! Copyright 1997-2018 Leibniz Universitaet Hannover
-! Copyright 2017-2018 Karlsruhe Institute of Technology
+! Copyright 2018-2018 Leibniz Universitaet Hannover
+! Copyright 2018-2018 Karlsruhe Institute of Technology
 !------------------------------------------------------------------------------!
 !
@@ -26,4 +26,8 @@
 ! -----------------
 ! $Id$
+! Moved USE radiation_model_mod from MODULE section into Subroutine
+! in order to use constant photolysis without radiation module (forkel)
+! 
+! 3287 2018-09-28 10:19:58Z forkel
 ! Modularization of all bulk cloud physics code components
 ! 
@@ -50,9 +54,6 @@
  MODULE chem_photolysis_mod
 
-    USE arrays_3d,                                                             &
-        ONLY:  dzw, hyp, pt, q, ql, zu, zw
-
-    USE basic_constants_and_equations_mod,                                     &
-        ONLY:  pi
+!   USE arrays_3d,                                                             &
+!       ONLY:  dzw, q, ql, zu, zw
 
     USE control_parameters,                                                    &
@@ -64,14 +65,6 @@
         ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
 
-    USE radiation_model_mod,                                                   &
-        ONLY:  calc_zenith, zenith
-               !day, day_init, lat, lambda, lon,                   &
-               !time_utc, time_utc_init,    !FKa: This is now handled by date_and_time_mod
-
     USE control_parameters,                                                    &
         ONLY:  initializing_actions           
-!       ONLY:  cloud_droplets, initializing_actions,                           &
-!              large_scale_forcing, lsf_surf, phi, pt_surface, rho_surface,    &
-!              surface_pressure, time_since_reference_point
 
     USE chem_gasphase_mod,                                                     &
@@ -84,7 +77,4 @@
         ONLY: chem_debug2
 
-!   REAL(wp), DIMENSION(0:0) ::  zenith,         & !< cosine of solar zenith angle
-!                                sun_dir_lat,    & !< solar directional vector in latitudes
-!                                sun_dir_lon       !< solar directional vector in longitudes
     USE kinds
 
@@ -106,20 +96,20 @@
 
 !-- Parameters for constant photolysis frequencies
-     INTEGER,PARAMETER :: nconst  = 15               !< available predefined photolysis prequencies for constant 
+    INTEGER,PARAMETER :: nconst  = 15               !< available predefined photolysis prequencies for constant 
 
 ! Names for predefined fixed photolysis frequencies at zenith angle 0
-     CHARACTER(LEN=10), PARAMETER, DIMENSION(nconst) :: names_c =  (/                    &
+    CHARACTER(LEN=10), PARAMETER, DIMENSION(nconst) :: names_c =  (/                    &
                      'J_O31D    ','J_O33P    ','J_NO2     ','J_HNO3    ','J_RCHO    ', &
                      'J         ','J         ','J         ','J         ','J         ', &
                      'J         ','J         ','J         ','J         ','J         ' /)
 ! Photolysis frequency at zenith angle 0 in 1/s
-     REAL(wp), PARAMETER, DIMENSION(nconst) :: phot0 =  (/                             &
-                     2.489E-05_wp,3.556E-04_wp, 8.89E-03_wp,5.334E-07_wp,3.734E-05_wp, &
-                     0.0000E00_wp,0.0000E00_wp,0.0000E00_wp,0.0000E00_wp,0.0000E00_wp, &
-                     0.0000E00_wp,0.0000E00_wp,0.0000E00_wp,0.0000E00_wp,0.0000E00_wp /)
+    REAL(wp), PARAMETER, DIMENSION(nconst) :: phot0 =  (/                             &
+                      2.489E-05_wp,3.556E-04_wp, 8.89E-03_wp,5.334E-07_wp,3.734E-05_wp, &
+                      0.0000E00_wp,0.0000E00_wp,0.0000E00_wp,0.0000E00_wp,0.0000E00_wp, &
+                      0.0000E00_wp,0.0000E00_wp,0.0000E00_wp,0.0000E00_wp,0.0000E00_wp /)
 
 
 !-- Parameters for simple photolysis frequencies
-     INTEGER,PARAMETER :: nsimple = 15               !< available predefined photolysis prequencies for simpel parameterisation
+    INTEGER,PARAMETER :: nsimple = 15               !< available predefined photolysis prequencies for simpel parameterisation
 ! Names for simple photolysis frequencies parameterisation (
      CHARACTER(LEN=10), PARAMETER, DIMENSION(nsimple) :: names_s =  (/                 &
@@ -146,18 +136,11 @@
 
 
-!    REAL(wp) :: time_photolysis = 0.0_wp,         & !< time since last call of photolysis code
-!                dt_photolysis = 0.0_wp,           & !< hotolysis model timestep
-!                skip_time_do_photolysis = 0.0_wp    !< Radiation model is not called before this time
+    REAL(wp) :: time_photolysis = 0.0_wp,         & !< time since last call of photolysis code
+                dt_photolysis = 0.0_wp,           & !< hotolysis model timestep
+                skip_time_do_photolysis = 0.0_wp    !< Radiation model is not called before this time
 
     REAL(wp)     :: cosz = 0.7_wp                   !< cosine of Zenith angle (45 deg, if not specified otherwise)
 
 !
-!-- Variables and parameters used in Fast-J only
-! ....
-
-!   INTERFACE photolysis_check_parameters
-!      MODULE PROCEDURE photolysis_check_parameters
-!   END INTERFACE photolysis_check_parameters
-  
     INTERFACE photolysis_constant
        MODULE PROCEDURE photolysis_constant
@@ -176,23 +159,4 @@
     END INTERFACE photolysis_control
 
-!   INTERFACE photolysis_header
-!      MODULE PROCEDURE photolysis_header
-!   END INTERFACE photolysis_header 
-! 
-    INTERFACE photolysis_init
-       MODULE PROCEDURE photolysis_init
-    END INTERFACE photolysis_init
-
-!   INTERFACE photolysis_parin
-!      MODULE PROCEDURE photolysis_parin
-!   END INTERFACE photolysis_parin
-    
-!   INTERFACE photolysis_read_restart_data
-!      MODULE PROCEDURE photolysis_read_restart_data
-!   END INTERFACE photolysis_read_restart_data
-
-!   INTERFACE photolysis_last_actions
-!      MODULE PROCEDURE photolysis_last_actions
-!   END INTERFACE photolysis_last_actions
 
     SAVE
@@ -200,15 +164,7 @@
     PRIVATE
 
-!
-!-- Public functions / NEEDS SORTING
-!   PUBLIC photolysis_init
-!          photolysis_check_parameters, photolysis_control,                      &
-!          photolysis_header, photolysis_init, photolysis_parin !,                 &
-!          photolysis_define_netcdf_grid, photolysis_last_actions,               &
-!          photolysis_read_restart_data, photolysis_data_output_mask
-
-   PUBLIC  photolysis_control, photolysis_init
-
-   PUBLIC  photolysis_scheme
+    PUBLIC  photolysis_control
+
+    PUBLIC  photolysis_scheme
 !
 
@@ -223,7 +179,5 @@
     SUBROUTINE photolysis_control
  
- 
        IMPLICIT NONE
-
 
        SELECT CASE ( TRIM( photolysis_scheme ) )
@@ -245,19 +199,4 @@
     END SUBROUTINE photolysis_control
 
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Initialization of the photolysis model
-!------------------------------------------------------------------------------!
-    SUBROUTINE photolysis_init    !### not yes used. Call should be placed near call of chem_init
-    
-       IMPLICIT NONE
-
-!-- Just in case we need anything
-
-       RETURN
-
-    END SUBROUTINE photolysis_init
-
 
 !------------------------------------------------------------------------------!
@@ -269,23 +208,15 @@
     SUBROUTINE photolysis_constant
 
-
        IMPLICIT NONE
 
-!      INTEGER(iwp) :: i, j, k   !< loop indices
        INTEGER(iwp) :: iphot,iav !< loop indix for photolysis reaction
-!      REAL(wp)     :: exn,   &  !< Exner functions at surface (better use palms own exner array in arrays_3d)
-!                      pt1       !< potential temperature at first grid level
 
        DO iphot = 1,nphot
           DO iav = 1,nconst
              IF ( TRIM( names_c(iav) ) == TRIM( phot_names(iphot) ) ) then
-!--    Prescribe fixed photolysis frequencies  [1/s]
-!             IF(myid == 0 .AND. chem_debug2 )  WRITE(06,*) iphot, iav,phot_names(iphot),names_c(iav)
-
-                      phot_frequen(iphot)%freq(nzb+1:nzt,:,:) =    &
-                            phot0(iav) * cosz
-
-!              IF(myid == 0 .AND. chem_debug2 )  WRITE(06,*) phot_frequen(iphot)%freq(1,5,5)
-            ENDIF
+!--             Prescribe fixed photolysis frequencies  [1/s]
+                phot_frequen(iphot)%freq(nzb+1:nzt,:,:) =    &
+                             phot0(iav) * cosz
+             ENDIF
           ENDDO
        ENDDO
@@ -303,35 +234,30 @@
     SUBROUTINE photolysis_simple
 
+       USE radiation_model_mod,                                                   &
+           ONLY:  calc_zenith, zenith
+
        IMPLICIT NONE
 
-!      INTEGER(iwp) :: i, j, k   !< loop indices
        INTEGER(iwp) :: iphot,iav !< loop indix for photolysis reaction
-!      REAL(wp)     :: exn,   &  !< Exner functions at surface (better use palms own exner array in arrays_3d)
-!                      pt1       !< potential temperature at first grid level
        REAL(wp)     :: coszi     !< 1./cosine of zenith angle
 
-    DO iphot = 1,nphot
-       phot_frequen(iphot)%freq = 0.0_wp
-    ENDDO
-
-    CALL calc_zenith
-
-    IF ( zenith(0) > 0.0_wp ) THEN
-       coszi = 1. / zenith(0)
-
        DO iphot = 1,nphot
-          DO iav = 1,nsimple
-             IF ( TRIM( names_s(iav) ) == TRIM( phot_names(iphot) ) ) then
-!              if(myid == 0 .AND. chem_debug2 )  WRITE(06,*) 'simple', iphot, iav,phot_names(iphot),names_s(iav)
-
-                      phot_frequen(iphot)%freq(nzb+1:nzt,:,:) =    &
-                            par_l(iav) * zenith(0)**par_m(iav) *  EXP( -par_n(iav) * coszi ) 
-
-!              if(myid == 0 .AND. chem_debug2 )  WRITE(06,*) 'simple', phot_frequen(iphot)%freq(1,5,5)
-            ENDIF
+          phot_frequen(iphot)%freq = 0.0_wp
+       ENDDO
+
+       CALL calc_zenith
+
+       IF ( zenith(0) > 0.0_wp ) THEN
+          coszi = 1. / zenith(0)
+
+          DO iphot = 1,nphot
+             DO iav = 1,nsimple
+                IF ( TRIM( names_s(iav) ) == TRIM( phot_names(iphot) ) ) then
+                   phot_frequen(iphot)%freq(nzb+1:nzt,:,:) =    &
+                                par_l(iav) * zenith(0)**par_m(iav) *  EXP( -par_n(iav) * coszi ) 
+                ENDIF
+             ENDDO
           ENDDO
-       ENDDO
-    ENDIF
-
+       ENDIF
     END SUBROUTINE photolysis_simple
 
Index: palm/trunk/SOURCE/chemistry_model_mod.f90
===================================================================
--- palm/trunk/SOURCE/chemistry_model_mod.f90	(revision 3297)
+++ palm/trunk/SOURCE/chemistry_model_mod.f90	(revision 3298)
@@ -15,5 +15,5 @@
 ! PALM. If not, see <http://www.gnu.org/licenses/>.
 !
-! Copyright 1997-2018 Leibniz Universitaet Hannover
+! Copyright 2017-2018 Leibniz Universitaet Hannover
 ! Copyright 2017-2018 Karlsruhe Institute of Technology
 ! Copyright 2017-2018 Freie Universitaet Berlin
@@ -27,12 +27,47 @@
 ! -----------------
 ! $Id$
+! Add remarks (kanani)
+! Merge with trunk, replaced cloud_physics by bulk_cloud_model         28.09.2018 forkel
+! Subroutines header and chem_check_parameters added                   25.09.2018 basit
+! Removed chem_emission routine now declared in chem_emissions.f90     30.07.2018 ERUSSO
+! Introduced emissions namelist parameters                             30.07.2018 ERUSSO
+!
+! Timestep steering added in subroutine chem_integrate_ij and 
+! output of chosen solver in chem_parin added                          30.07.2018 ketelsen
+!
+! chem_check_data_output_pr: added unit for PM compounds               20.07.2018 forkel
+! replaced : by nzb+1:nzt for pt,q,ql (found by kk)                    18.07.2018 forkel
+! debugged restart run for chem species               06.07.2018 basit
+! reorganized subroutines in alphabetical order.      27.06.2018 basit
+! subroutine chem_parin updated for profile output    27.06.2018 basit
+! Added humidity arrays to USE section and tmp_qvap in chem_integrate  26.6.2018 forkel
+! Merged chemistry with with trunk (nzb_do and nzt_do in 3d output)    26.6.2018 forkel
+!
+! reorganized subroutines in alphabetical order.      basit 22.06.2018
+! subroutine chem_parin updated for profile output    basit 22.06.2018
+! subroutine chem_statistics added                  
+! subroutine chem_check_data_output_pr add            21.06.2018 basit
+! subroutine chem_data_output_mask added              20.05.2018 basit
+! subroutine chem_data_output_2d added                20.05.2018 basit
+! subroutine chem_statistics added                    04.06.2018 basit
+! subroutine chem_emissions: Set cssws to zero before setting values 20.03.2018 forkel
+! subroutine chem_emissions: Introduced different conversion factors 
+! for PM and gaseous compounds                                    15.03.2018 forkel
+! subroutine chem_emissions updated to take variable number of chem_spcs and
+! emission factors.                                               13.03.2018 basit
+! chem_boundary_conds_decycle improved.                           05.03.2018 basit
+! chem_boundary_conds_decycle subroutine added                    21.02.2018 basit
+! chem_init_profiles subroutines re-activated after correction    21.02.2018 basit
+! 
+! 
+! 3293 2018-09-28 12:45:20Z forkel
 ! Modularization of all bulk cloud physics code components
-! 
+!
 ! 3248 2018-09-14 09:42:06Z sward
 ! Minor formating changes
-! 
+!
 ! 3246 2018-09-13 15:14:50Z sward
 ! Added error handling for input namelist via parin_fail_message
-! 
+!
 ! 3241 2018-09-12 15:02:00Z raasch
 ! +nest_chemistry
@@ -130,5 +165,4 @@
 !>       turned off. Need to be fixed. bK
 !> @todo test nesting for chem spcs, was implemented by suehring (kanani)
-!> @todo subroutine set_const_initial_values to be taken out from chemistry_model_mod !bK.
 !> @todo chemistry error messages
 !> @todo Format this module according to PALM coding standard (see e.g. module
@@ -138,163 +172,310 @@
 !------------------------------------------------------------------------------!
 
-MODULE chemistry_model_mod
-
-   USE kinds,              ONLY: wp, iwp
-   USE indices,            ONLY: nz, nzb,nzt,nysg,nyng,nxlg,nxrg,nys,nyn
-   USE pegrid,             ONLY: myid, threads_per_task
-   USE control_parameters, ONLY: dt_3d, ws_scheme_sca, initializing_actions, message_string, &
-                                 omega, tsc, intermediate_timestep_count,      &
-                                 intermediate_timestep_count_max,              &
-                                 timestep_scheme, use_prescribed_profile_data  
-   USE arrays_3d,          ONLY: hyp, pt, rdf_sc, tend, zu, exner
-   USE chem_gasphase_mod,  ONLY: nspec, spc_names, nkppctrl, nmaxfixsteps,     &
-                                 t_steps, fill_temp, chem_gasphase_integrate,  &
-                                 nvar, atol, rtol, nphot, phot_names
-   USE cpulog,             ONLY: cpu_log, log_point
-
-   USE chem_modules
+ MODULE chemistry_model_mod
+    USE MPI
+
+    USE kinds,              ONLY: wp, iwp
+    USE indices,            ONLY: nz, nzb,nzt,nysg,nyng,nxlg,nxrg,                                 &
+                                 nys,nyn,nx,nxl,nxr,ny,wall_flags_0
+    USE pegrid,             ONLY: myid, threads_per_task
+
+   USE bulk_cloud_model_mod,                                               &
+        ONLY:  bulk_cloud_model
+
+    USE control_parameters, ONLY: bc_lr_cyc, bc_ns_cyc, dt_3d, humidity,                           &
+                                 initializing_actions, message_string,                             &
+                                 omega, tsc, intermediate_timestep_count,                          &
+                                 intermediate_timestep_count_max,                                  &
+                                 timestep_scheme, use_prescribed_profile_data, ws_scheme_sca  
+   USE arrays_3d,          ONLY: exner, hyp, pt, q, ql, rdf_sc, tend, zu
+    USE chem_gasphase_mod,  ONLY: nspec, spc_names, nkppctrl, nmaxfixsteps,                        &
+                                 t_steps, chem_gasphase_integrate, vl_dim,                         &
+                                 nvar, nreact,  atol, rtol, nphot, phot_names
+    USE cpulog,             ONLY: cpu_log, log_point
+
+    USE chem_modules
  
-
-   IMPLICIT   NONE
-   PRIVATE
-   SAVE
-
-   LOGICAL ::  nest_chemistry = .TRUE. !< flag for nesting mode of chemical species, independent on parent or not
+    USE statistics
+
+    IMPLICIT   NONE
+    PRIVATE
+    SAVE
+
+    LOGICAL ::  nest_chemistry = .TRUE. !< flag for nesting mode of chemical species, independent on parent or not
 !
 !- Define chemical variables
-   TYPE   species_def
-      CHARACTER(LEN=8)                                   :: name
-      CHARACTER(LEN=16)                                  :: unit
-      REAL(kind=wp),POINTER,DIMENSION(:,:,:)             :: conc
-      REAL(kind=wp),POINTER,DIMENSION(:,:,:)             :: conc_av
-      REAL(kind=wp),POINTER,DIMENSION(:,:,:)             :: conc_p
-      REAL(kind=wp),POINTER,DIMENSION(:,:,:)             :: tconc_m
-      REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:)           :: cssws_av           
-      REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:)           :: flux_s_cs
-      REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:)           :: diss_s_cs
-      REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:)         :: flux_l_cs
-      REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:)         :: diss_l_cs
-      REAL(kind=wp),ALLOCATABLE,DIMENSION(:)             :: conc_pr_init
-   END TYPE species_def
-
-
-   TYPE   photols_def                                                            
-      CHARACTER(LEN=8)                                   :: name
-      CHARACTER(LEN=16)                                  :: unit
-      REAL(kind=wp),POINTER,DIMENSION(:,:,:)             :: freq
-   END TYPE photols_def
-
-
-   PUBLIC  species_def
-   PUBLIC  photols_def
-
-
-   TYPE(species_def),ALLOCATABLE,DIMENSION(:),TARGET, PUBLIC     :: chem_species
-   TYPE(photols_def),ALLOCATABLE,DIMENSION(:),TARGET, PUBLIC     :: phot_frequen  
-
-   REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:,:),TARGET   :: spec_conc_1
-   REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:,:),TARGET   :: spec_conc_2
-   REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:,:),TARGET   :: spec_conc_3
-   REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:,:),TARGET   :: spec_conc_av       
-   REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:,:),TARGET   :: freq_1
-
-   INTEGER,DIMENSION(nkppctrl)                           :: icntrl                            ! Fine tuning kpp
-   REAL(kind=wp),DIMENSION(nkppctrl)                     :: rcntrl                            ! Fine tuning kpp
-
-   CHARACTER(10), PUBLIC :: photolysis_scheme
+    TYPE   species_def
+       CHARACTER(LEN=8)                                   :: name
+       CHARACTER(LEN=16)                                  :: unit
+       REAL(kind=wp),POINTER,DIMENSION(:,:,:)             :: conc
+       REAL(kind=wp),POINTER,DIMENSION(:,:,:)             :: conc_av
+       REAL(kind=wp),POINTER,DIMENSION(:,:,:)             :: conc_p
+       REAL(kind=wp),POINTER,DIMENSION(:,:,:)             :: tconc_m
+       REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:)           :: cssws_av           
+       REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:)           :: flux_s_cs
+       REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:)           :: diss_s_cs
+       REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:)         :: flux_l_cs
+       REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:)         :: diss_l_cs
+       REAL(kind=wp),ALLOCATABLE,DIMENSION(:)             :: conc_pr_init
+    END TYPE species_def
+
+
+    TYPE   photols_def                                                            
+       CHARACTER(LEN=8)                                   :: name
+       CHARACTER(LEN=16)                                  :: unit
+       REAL(kind=wp),POINTER,DIMENSION(:,:,:)             :: freq
+    END TYPE photols_def
+
+
+    PUBLIC  species_def
+    PUBLIC  photols_def
+
+
+    TYPE(species_def),ALLOCATABLE,DIMENSION(:),TARGET, PUBLIC     :: chem_species
+    TYPE(photols_def),ALLOCATABLE,DIMENSION(:),TARGET, PUBLIC     :: phot_frequen  
+
+    REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:,:),TARGET   :: spec_conc_1
+    REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:,:),TARGET   :: spec_conc_2
+    REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:,:),TARGET   :: spec_conc_3
+    REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:,:),TARGET   :: spec_conc_av       
+    REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:,:),TARGET   :: freq_1
+
+    INTEGER,DIMENSION(nkppctrl)                           :: icntrl                            ! Fine tuning kpp
+    REAL(kind=wp),DIMENSION(nkppctrl)                     :: rcntrl                            ! Fine tuning kpp
+    LOGICAL :: decycle_chem_lr    = .FALSE.
+    LOGICAL :: decycle_chem_ns    = .FALSE.
+    CHARACTER (LEN=20), DIMENSION(4) ::  decycle_method = &
+                  (/'dirichlet','dirichlet','dirichlet','dirichlet'/)
+                                 !< Decycling method at horizontal boundaries, 
+                                 !< 1=left, 2=right, 3=south, 4=north
+                                 !< dirichlet = initial size distribution and 
+                                 !< chemical composition set for the ghost and 
+                                 !< first three layers
+                                 !< neumann = zero gradient
+
+    REAL(kind=wp), PUBLIC :: cs_time_step
+    CHARACTER(10), PUBLIC :: photolysis_scheme
                                          ! 'constant',
                                          ! 'simple' (Simple parameterisation from MCM, Saunders et al., 2003, Atmos. Chem. Phys., 3, 161-180
                                          ! 'fastj'  (Wild et al., 2000, J. Atmos. Chem., 37, 245-282) STILL NOT IMPLEMENTED
 
-   PUBLIC nest_chemistry, nspec
-   PUBLIC nvar       
-   PUBLIC spc_names
-   PUBLIC spec_conc_2  
-
-!- Interface section
-  INTERFACE chem_boundary_conds
-      MODULE PROCEDURE chem_boundary_conds
-  END INTERFACE chem_boundary_conds
-
-   INTERFACE chem_init
-      MODULE PROCEDURE chem_init
-   END INTERFACE chem_init
-
-   INTERFACE chem_init_profiles
-      MODULE PROCEDURE chem_init_profiles
-   END INTERFACE chem_init_profiles
-
-   INTERFACE chem_parin
-      MODULE PROCEDURE chem_parin
-   END INTERFACE chem_parin
-
-   INTERFACE chem_integrate
-      MODULE PROCEDURE chem_integrate_ij
-   END INTERFACE chem_integrate
-
-   INTERFACE chem_swap_timelevel
-      MODULE PROCEDURE chem_swap_timelevel
-   END INTERFACE chem_swap_timelevel
-
-   INTERFACE chem_define_netcdf_grid
-      MODULE PROCEDURE chem_define_netcdf_grid
-   END INTERFACE chem_define_netcdf_grid
-
-   INTERFACE chem_data_output_3d
-      MODULE PROCEDURE chem_data_output_3d
-   END INTERFACE chem_data_output_3d
-
-   INTERFACE chem_check_data_output
-      MODULE PROCEDURE chem_check_data_output
-   END INTERFACE chem_check_data_output
-
-   INTERFACE chem_check_data_output_pr
-      MODULE PROCEDURE chem_check_data_output_pr
-   END INTERFACE chem_check_data_output_pr
-
-   INTERFACE chem_3d_data_averaging
-      MODULE PROCEDURE chem_3d_data_averaging 
-   END INTERFACE chem_3d_data_averaging
-
-   INTERFACE chem_wrd_local
-      MODULE PROCEDURE chem_wrd_local 
-   END INTERFACE chem_wrd_local
-
-   INTERFACE chem_rrd_local
-      MODULE PROCEDURE chem_rrd_local
-   END INTERFACE chem_rrd_local
-
-   INTERFACE chem_prognostic_equations
-      MODULE PROCEDURE chem_prognostic_equations
-      MODULE PROCEDURE chem_prognostic_equations_ij
-   END INTERFACE chem_prognostic_equations
-
-   INTERFACE chem_header
-      MODULE PROCEDURE chem_header
-   END INTERFACE chem_header
-
-   INTERFACE chem_emissions
-      MODULE PROCEDURE chem_emissions
-   END INTERFACE chem_emissions
-
-!    INTERFACE chem_wrd_global
-!       MODULE PROCEDURE chem_wrd_global
-!    END INTERFACE chem_wrd_global
-! 
-!    INTERFACE chem_rrd_global
-!       MODULE PROCEDURE chem_rrd_global
-!    END INTERFACE chem_rrd_global
-
-
-   PUBLIC chem_3d_data_averaging, chem_boundary_conds, chem_check_data_output, &
-          chem_check_data_output_pr, chem_data_output_3d,                      &
-          chem_define_netcdf_grid, chem_emissions, chem_header, chem_init,     &
-          chem_init_profiles, chem_integrate, chem_wrd_local,                  &
-          chem_parin, chem_prognostic_equations,                               &
-          chem_rrd_local, chem_swap_timelevel
+    PUBLIC nest_chemistry
+    PUBLIC nspec
+    PUBLIC nreact
+    PUBLIC nvar      
+    PUBLIC spc_names
+    PUBLIC spec_conc_2  
+
+!-  Interface section
+    INTERFACE chem_3d_data_averaging
+       MODULE PROCEDURE chem_3d_data_averaging 
+    END INTERFACE chem_3d_data_averaging
+
+    INTERFACE chem_boundary_conds
+       MODULE PROCEDURE chem_boundary_conds
+       MODULE PROCEDURE chem_boundary_conds_decycle
+    END INTERFACE chem_boundary_conds
+
+    INTERFACE chem_check_data_output
+       MODULE PROCEDURE chem_check_data_output
+    END INTERFACE chem_check_data_output
+
+    INTERFACE chem_data_output_2d
+       MODULE PROCEDURE chem_data_output_2d
+    END INTERFACE chem_data_output_2d
+
+    INTERFACE chem_data_output_3d
+       MODULE PROCEDURE chem_data_output_3d
+    END INTERFACE chem_data_output_3d
+
+    INTERFACE chem_data_output_mask
+       MODULE PROCEDURE chem_data_output_mask
+    END INTERFACE chem_data_output_mask
+
+    INTERFACE chem_check_data_output_pr
+       MODULE PROCEDURE chem_check_data_output_pr
+    END INTERFACE chem_check_data_output_pr
+
+    INTERFACE chem_check_parameters
+       MODULE PROCEDURE chem_check_parameters
+    END INTERFACE chem_check_parameters
+
+    INTERFACE chem_define_netcdf_grid
+       MODULE PROCEDURE chem_define_netcdf_grid
+    END INTERFACE chem_define_netcdf_grid
+
+    INTERFACE chem_header
+       MODULE PROCEDURE chem_header
+    END INTERFACE chem_header
+
+    INTERFACE chem_init
+       MODULE PROCEDURE chem_init
+    END INTERFACE chem_init
+
+    INTERFACE chem_init_profiles
+       MODULE PROCEDURE chem_init_profiles
+    END INTERFACE chem_init_profiles
+
+    INTERFACE chem_integrate
+       MODULE PROCEDURE chem_integrate_ij
+    END INTERFACE chem_integrate
+
+    INTERFACE chem_parin
+       MODULE PROCEDURE chem_parin
+    END INTERFACE chem_parin
+
+    INTERFACE chem_prognostic_equations
+       MODULE PROCEDURE chem_prognostic_equations
+       MODULE PROCEDURE chem_prognostic_equations_ij
+    END INTERFACE chem_prognostic_equations
+
+    INTERFACE chem_rrd_local
+       MODULE PROCEDURE chem_rrd_local
+    END INTERFACE chem_rrd_local
+
+    INTERFACE chem_statistics
+       MODULE PROCEDURE chem_statistics
+    END INTERFACE chem_statistics
+
+    INTERFACE chem_swap_timelevel
+       MODULE PROCEDURE chem_swap_timelevel
+    END INTERFACE chem_swap_timelevel
+
+    INTERFACE chem_wrd_local
+       MODULE PROCEDURE chem_wrd_local 
+    END INTERFACE chem_wrd_local
+
+
+    PUBLIC chem_3d_data_averaging, chem_boundary_conds, chem_check_data_output, &
+           chem_check_data_output_pr, chem_check_parameters,                    &
+           chem_data_output_2d, chem_data_output_3d, chem_data_output_mask,     &
+           chem_define_netcdf_grid, chem_header, chem_init,                     &
+           chem_init_profiles, chem_integrate, chem_parin,                      &
+           chem_prognostic_equations, chem_rrd_local,                           &
+           chem_statistics, chem_swap_timelevel, chem_wrd_local 
+
+
+
+ CONTAINS
+
+!
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine for averaging 3D data of chemical species. Due to the fact that 
+!> the averaged chem arrays are allocated in chem_init, no if-query concerning
+!> the allocation is required (in any mode). Attention: If you just specify an 
+!> averaged output quantity in the _p3dr file during restarts the first output
+!> includes the time between the beginning of the restart run and the first
+!> output time (not necessarily the whole averaging_interval you have 
+!> specified in your _p3d/_p3dr file )
+!------------------------------------------------------------------------------!
+
+    SUBROUTINE chem_3d_data_averaging ( mode, variable )
+
+       USE control_parameters
+
+       USE indices
+
+       USE kinds
+
+       USE surface_mod,                                                         &
+          ONLY: surf_def_h, surf_lsm_h, surf_usm_h   
+  
+       IMPLICIT NONE
+ 
+       CHARACTER (LEN=*) ::  mode    !< 
+       CHARACTER (LEN=*) :: variable !< 
+ 
+       LOGICAL      ::  match_def !< flag indicating natural-type surface
+       LOGICAL      ::  match_lsm !< flag indicating natural-type surface
+       LOGICAL      ::  match_usm !< flag indicating urban-type surface
+
+       INTEGER(iwp) ::  i                  !< grid index x direction
+       INTEGER(iwp) ::  j                  !< grid index y direction
+       INTEGER(iwp) ::  k                  !< grid index z direction
+       INTEGER(iwp) ::  m                  !< running index surface type
+       INTEGER(iwp) :: lsp                 !< running index for chem spcs
+
+
+       IF ( mode == 'allocate' )  THEN
+          DO lsp = 1, nspec
+             IF (TRIM(variable(4:)) == TRIM(chem_species(lsp)%name)) THEN
+                chem_species(lsp)%conc_av = 0.0_wp
+                
+             ENDIF
+          ENDDO
+
+       ELSEIF ( mode == 'sum' )  THEN
+
+
+          DO lsp = 1, nspec
+             IF (TRIM(variable(4:)) == TRIM(chem_species(lsp)%name)) THEN
+                DO  i = nxlg, nxrg
+                   DO  j = nysg, nyng
+                      DO  k = nzb, nzt+1
+                          chem_species(lsp)%conc_av(k,j,i) = chem_species(lsp)%conc_av(k,j,i) + &
+                                                             chem_species(lsp)%conc(k,j,i)
+                      ENDDO
+                   ENDDO
+                ENDDO
+             ELSEIF ( TRIM(variable(4:)) == TRIM('cssws*') )        THEN
+                DO  i = nxl, nxr
+                   DO  j = nys, nyn
+                      match_def = surf_def_h(0)%start_index(j,i) <=               &
+                                  surf_def_h(0)%end_index(j,i)
+                      match_lsm = surf_lsm_h%start_index(j,i) <=                  &
+                                  surf_lsm_h%end_index(j,i)
+                      match_usm = surf_usm_h%start_index(j,i) <=                  &
+                                  surf_usm_h%end_index(j,i)
+
+                      IF ( match_def )  THEN
+                         m = surf_def_h(0)%end_index(j,i)
+                         chem_species(lsp)%cssws_av(j,i) =                        &
+                                                chem_species(lsp)%cssws_av(j,i) + &
+                                                surf_def_h(0)%cssws(lsp,m)
+                      ELSEIF ( match_lsm  .AND.  .NOT. match_usm )  THEN
+                         m = surf_lsm_h%end_index(j,i)
+                         chem_species(lsp)%cssws_av(j,i) =                        &
+                                                chem_species(lsp)%cssws_av(j,i) + &
+                                                surf_lsm_h%cssws(lsp,m)
+                      ELSEIF ( match_usm )  THEN
+                         m = surf_usm_h%end_index(j,i)
+                         chem_species(lsp)%cssws_av(j,i) =                        &
+                                                chem_species(lsp)%cssws_av(j,i) + &
+                                                surf_usm_h%cssws(lsp,m)
+                      ENDIF
+                   ENDDO
+                ENDDO
+             ENDIF
+          ENDDO
+ 
+       ELSEIF ( mode == 'average' )  THEN
+          DO lsp = 1, nspec
+             IF (TRIM(variable(4:)) == TRIM(chem_species(lsp)%name)) THEN
+                DO  i = nxlg, nxrg
+                   DO  j = nysg, nyng
+                      DO  k = nzb, nzt+1
+                          chem_species(lsp)%conc_av(k,j,i) = chem_species(lsp)%conc_av(k,j,i) / REAL( average_count_3d, KIND=wp )
+                      ENDDO
+                   ENDDO
+                ENDDO
+
+             ELSEIF (TRIM(variable(4:)) == TRIM('cssws*') )            THEN
+                DO i = nxlg, nxrg
+                   DO  j = nysg, nyng
+                        chem_species(lsp)%cssws_av(j,i) = chem_species(lsp)%cssws_av(j,i) / REAL( average_count_3d, KIND=wp )
+                   ENDDO
+                ENDDO
+                   CALL exchange_horiz_2d( chem_species(lsp)%cssws_av, nbgp )                 
+             ENDIF
+          ENDDO
           
-
- CONTAINS
-
+       ENDIF     
+
+    END SUBROUTINE chem_3d_data_averaging
+
+!    
 !------------------------------------------------------------------------------!
 !
@@ -304,761 +485,296 @@
 !------------------------------------------------------------------------------!
 
- SUBROUTINE chem_boundary_conds( mode )                                           
-                                                                                  
-    USE control_parameters,                                                    &  
-        ONLY:  bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s
-
-    USE indices,                                                               &  
-        ONLY:  nxl, nxr, nzt
-                                                                                  
-    USE arrays_3d,                                                             &     
-        ONLY:  dzu                                                
-
-    USE surface_mod,                                                           &
-        ONLY:  bc_h                                                           
-
-    CHARACTER (len=*), INTENT(IN) :: mode
-    INTEGER(iwp) ::  i                                                            !< grid index x direction.
-    INTEGER(iwp) ::  j                                                            !< grid index y direction.
-    INTEGER(iwp) ::  k                                                            !< grid index z direction.
-    INTEGER(iwp) ::  kb                                                           !< variable to set respective boundary value, depends on facing. 
-    INTEGER(iwp) ::  l                                                            !< running index boundary type, for up- and downward-facing walls.
-    INTEGER(iwp) ::  m                                                            !< running index surface elements.
-    INTEGER(iwp) ::  lsp                                                          !< running index for chem spcs.
-
-
-    SELECT CASE ( TRIM( mode ) )        
-       CASE ( 'init' )     
-          DO lsp = 1, nspec            
-            IF ( surface_csflux(lsp) == 9999999.9_wp )  THEN
-                 constant_csflux(lsp) = .FALSE.            
-            ENDIF
-          ENDDO
-
-          IF ( bc_cs_b == 'dirichlet' )    THEN
-             ibc_cs_b = 0 
-          ELSEIF ( bc_cs_b == 'neumann' )  THEN
-             ibc_cs_b = 1 
-          ELSE
-!             message_string = 'unknown boundary condition: bc_cs_b ="' // TRIM( bc_cs_b ) // '"'  ! bK commented
-             CALL message( 'chem_boundary_conds', 'CM0010', 1, 2, 0, 6, 0 )     !< chemistry_model_mod should have special error numbers --> "CHEM###",
-          ENDIF                                                                  
-!
-!--       Set Integer flags and check for possible erroneous settings for top
-!--       boundary condition. bK added *_cs_* here.
-          IF ( bc_cs_t == 'dirichlet' )             THEN
-             ibc_cs_t = 0 
-          ELSEIF ( bc_cs_t == 'neumann' )           THEN
-             ibc_cs_t = 1
-          ELSEIF ( bc_cs_t == 'initial_gradient' )  THEN
-             ibc_cs_t = 2
-          ELSEIF ( bc_cs_t == 'nested' )            THEN          
-             ibc_cs_t = 3
-          ELSE
-!            message_string = 'unknown boundary condition: bc_c_t ="' // TRIM( bc_cs_t ) // '"'  
-             CALL message( 'check_parameters', 'CM0011', 1, 2, 0, 6, 0 )
-          ENDIF
-
-      
-       CASE ( 'set_bc_bottomtop' )                   
-!--      Bottom boundary condtions for chemical species      
-          DO lsp = 1, nspec                                                      
-             IF ( ibc_cs_b == 0 ) THEN                   
-                DO l = 0, 1 
-!--             Set index kb: For upward-facing surfaces (l=0), kb=-1, i.e.
-!--             the chem_species(nsp)%conc_p value at the topography top (k-1)
-!--             is set; for downward-facing surfaces (l=1), kb=1, i.e. the 
-!--             value at the topography bottom (k+1) is set. 
-
-                   kb = MERGE( -1, 1, l == 0 )
-                   !$OMP PARALLEL DO PRIVATE( i, j, k )
-                   DO m = 1, bc_h(l)%ns
-                      i = bc_h(l)%i(m)            
-                      j = bc_h(l)%j(m)
-                      k = bc_h(l)%k(m)
-                      chem_species(lsp)%conc_p(k+kb,j,i) = chem_species(lsp)%conc(k+kb,j,i) 
-                   ENDDO                                        
-                ENDDO                                       
-          
-             ELSEIF ( ibc_cs_b == 1 ) THEN
-         ! in boundary_conds there is som extra loop over m here for passive tracer
-                DO l = 0, 1
-                   kb = MERGE( -1, 1, l == 0 )
-                   !$OMP PARALLEL DO PRIVATE( i, j, k )                                           
-                   DO m = 1, bc_h(l)%ns
-                      i = bc_h(l)%i(m)            
-                      j = bc_h(l)%j(m)
-                      k = bc_h(l)%k(m)
-                      chem_species(lsp)%conc_p(k+kb,j,i) = chem_species(lsp)%conc_p(k,j,i)
-
-!< @todo: chem_species(nsp)%conc_p(k+kb,j,i) = chem_species(nsp)%conc(k+kb,j,i),    &
-!<  pls loop over nsp=1, NSPEC.
-!< @todo: We should also think about the possibility to have &
-!< individual boundary conditions for each species? This means, bc_cs_b,       &
-!< bc_cs_t, ibc_cs_b, ibc_cs_t would need to be added to TYPE chem_species(nsp)%,   &
-!< and the loop over nsp would have to be put outside of this IF-clause.
-!< i think its better we keep the same bonundary cond i.e. dirichlet or neumann
-!< for all chem spcs. ... !bK
-
+    SUBROUTINE chem_boundary_conds( mode )                                           
+                                                                                     
+       USE control_parameters,                                                    &  
+          ONLY:  air_chemistry, bc_radiation_l, bc_radiation_n, bc_radiation_r,  &
+                 bc_radiation_s                
+       USE indices,                                                               &  
+          ONLY:  nxl, nxr,  nxlg, nxrg, nyng, nysg, nzt                              
+                                                                                     
+
+       USE arrays_3d,                                                             &     
+          ONLY:  dzu                                                
+       USE surface_mod,                                                           &
+          ONLY:  bc_h                                                           
+
+       CHARACTER (len=*), INTENT(IN) :: mode
+       INTEGER(iwp) ::  i                                                            !< grid index x direction.
+       INTEGER(iwp) ::  j                                                            !< grid index y direction.
+       INTEGER(iwp) ::  k                                                            !< grid index z direction.
+       INTEGER(iwp) ::  kb                                                           !< variable to set respective boundary value, depends on facing. 
+       INTEGER(iwp) ::  l                                                            !< running index boundary type, for up- and downward-facing walls.
+       INTEGER(iwp) ::  m                                                            !< running index surface elements.
+       INTEGER(iwp) ::  lsp                                                          !< running index for chem spcs.
+       INTEGER(iwp) ::  lph                                                          !< running index for photolysis frequencies
+
+
+       SELECT CASE ( TRIM( mode ) )        
+          CASE ( 'init' )
+
+             IF ( bc_cs_b == 'dirichlet' )    THEN
+                ibc_cs_b = 0 
+             ELSEIF ( bc_cs_b == 'neumann' )  THEN
+                ibc_cs_b = 1 
+             ELSE
+                message_string = 'unknown boundary condition: bc_cs_b ="' // TRIM( bc_cs_b ) // '"'  
+                CALL message( 'chem_boundary_conds', 'CM0429', 1, 2, 0, 6, 0 )     !<
+             ENDIF                                                                  
+!
+!--          Set Integer flags and check for possible erroneous settings for top
+!--          boundary condition. 
+             IF ( bc_cs_t == 'dirichlet' )             THEN
+                ibc_cs_t = 0 
+             ELSEIF ( bc_cs_t == 'neumann' )           THEN
+                ibc_cs_t = 1
+             ELSEIF ( bc_cs_t == 'initial_gradient' )  THEN
+                ibc_cs_t = 2
+             ELSEIF ( bc_cs_t == 'nested' )            THEN          
+                ibc_cs_t = 3
+             ELSE
+                message_string = 'unknown boundary condition: bc_c_t ="' // TRIM( bc_cs_t ) // '"'      
+                CALL message( 'check_parameters', 'CM0430', 1, 2, 0, 6, 0 )
+             ENDIF
+
+         
+          CASE ( 'set_bc_bottomtop' )                   
+!--          Bottom boundary condtions for chemical species      
+             DO lsp = 1, nspec                                                      
+                IF ( ibc_cs_b == 0 ) THEN                   
+                   DO l = 0, 1 
+!--                Set index kb: For upward-facing surfaces (l=0), kb=-1, i.e.
+!--                the chem_species(nspec)%conc_p value at the topography top (k-1)
+!--                is set; for downward-facing surfaces (l=1), kb=1, i.e. the 
+!--                value at the topography bottom (k+1) is set. 
+
+                      kb = MERGE( -1, 1, l == 0 )
+                      !$OMP PARALLEL DO PRIVATE( i, j, k )
+                      DO m = 1, bc_h(l)%ns
+                         i = bc_h(l)%i(m)            
+                         j = bc_h(l)%j(m)
+                         k = bc_h(l)%k(m)
+                         chem_species(lsp)%conc_p(k+kb,j,i) = chem_species(lsp)%conc(k+kb,j,i) 
+                      ENDDO                                        
+                   ENDDO                                       
+             
+                ELSEIF ( ibc_cs_b == 1 ) THEN
+!--             in boundary_conds there is som extra loop over m here for passive tracer
+                   DO l = 0, 1
+                      kb = MERGE( -1, 1, l == 0 )
+                      !$OMP PARALLEL DO PRIVATE( i, j, k )                                           
+                      DO m = 1, bc_h(l)%ns
+                         i = bc_h(l)%i(m)            
+                         j = bc_h(l)%j(m)
+                         k = bc_h(l)%k(m)
+                         chem_species(lsp)%conc_p(k+kb,j,i) = chem_species(lsp)%conc_p(k,j,i)
+
+                      ENDDO
+                   ENDDO
+                ENDIF
+          ENDDO    ! end lsp loop  
+
+!--    Top boundary conditions for chemical species - Should this not be done for all species?
+             IF ( ibc_cs_t == 0 )  THEN                    
+                DO lsp = 1, nspec
+                   chem_species(lsp)%conc_p(nzt+1,:,:) = chem_species(lsp)%conc(nzt+1,:,:)        
+                ENDDO
+             ELSEIF ( ibc_cs_t == 1 )  THEN
+                DO lsp = 1, nspec
+                   chem_species(lsp)%conc_p(nzt+1,:,:) = chem_species(lsp)%conc_p(nzt,:,:)
+                ENDDO
+             ELSEIF ( ibc_cs_t == 2 )  THEN
+                DO lsp = 1, nspec
+                   chem_species(lsp)%conc_p(nzt+1,:,:) = chem_species(lsp)%conc_p(nzt,:,:) + bc_cs_t_val(lsp) * dzu(nzt+1)
+                ENDDO
+             ENDIF
+!
+          CASE ( 'set_bc_lateral' )                       
+!--             Lateral boundary conditions for chem species at inflow boundary
+!--             are automatically set when chem_species concentration is
+!--             initialized. The initially set value at the inflow boundary is not
+!--             touched during time integration, hence, this boundary value remains
+!--             at a constant value, which is the concentration that flows into the
+!--             domain.                                                           
+!--             Lateral boundary conditions for chem species at outflow boundary 
+
+             IF ( bc_radiation_s )  THEN
+                DO lsp = 1, nspec
+                   chem_species(lsp)%conc_p(:,nys-1,:) = chem_species(lsp)%conc_p(:,nys,:)
+                ENDDO
+             ELSEIF ( bc_radiation_n )  THEN
+                DO lsp = 1, nspec
+                   chem_species(lsp)%conc_p(:,nyn+1,:) = chem_species(lsp)%conc_p(:,nyn,:)
+                ENDDO
+             ELSEIF ( bc_radiation_l )  THEN
+                DO lsp = 1, nspec
+                   chem_species(lsp)%conc_p(:,:,nxl-1) = chem_species(lsp)%conc_p(:,:,nxl)
+                ENDDO
+             ELSEIF ( bc_radiation_r )  THEN
+                DO lsp = 1, nspec
+                   chem_species(lsp)%conc_p(:,:,nxr+1) = chem_species(lsp)%conc_p(:,:,nxr)
+                ENDDO
+             ENDIF
+            
+       END SELECT
+
+    END SUBROUTINE chem_boundary_conds
+
+!
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Boundary conditions for prognostic variables in chemistry: decycling in the 
+!> x-direction
+!-----------------------------------------------------------------------------
+    SUBROUTINE chem_boundary_conds_decycle (cs_3d, cs_pr_init )
+       USE pegrid,                                                             &
+                 ONLY: myid
+
+       IMPLICIT NONE 
+       INTEGER(iwp) ::  boundary !< 
+       INTEGER(iwp) ::  ee !<
+       INTEGER(iwp) ::  copied !< 
+       INTEGER(iwp) ::  i !< 
+       INTEGER(iwp) ::  j !< 
+       INTEGER(iwp) ::  k !< 
+       INTEGER(iwp) ::  ss !< 
+       REAL(wp), DIMENSION(nzb:nzt+1) ::  cs_pr_init
+       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  cs_3d
+       REAL(wp) ::  flag !< flag to mask topography grid points
+
+       flag = 0.0_wp
+
+       
+!--    Left and right boundaries
+       IF ( decycle_chem_lr  .AND.  bc_lr_cyc )  THEN
+
+          DO  boundary = 1, 2
+
+             IF ( decycle_method(boundary) == 'dirichlet' )  THEN
+!    
+!--             Initial profile is copied to ghost and first three layers          
+                ss = 1
+                ee = 0
+                IF ( boundary == 1  .AND.  nxl == 0 )  THEN
+                   ss = nxlg
+                   ee = nxl+2
+                ELSEIF ( boundary == 2  .AND.  nxr == nx )  THEN
+                   ss = nxr-2
+                   ee = nxrg
+                ENDIF
+
+                DO  i = ss, ee
+                   DO  j = nysg, nyng
+                      DO  k = nzb+1, nzt
+                         flag = MERGE( 1.0_wp, 0.0_wp,                            &
+                                       BTEST( wall_flags_0(k,j,i), 0 ) )
+                         cs_3d(k,j,i) = cs_pr_init(k) * flag
+                      ENDDO
                    ENDDO
                 ENDDO
-             ENDIF
-          ENDDO    ! end lsp loop  
-
-!--    Top boundary conditions for chemical species - Should this not be done for all species?
-          IF ( ibc_cs_t == 0 )  THEN                    
-             DO lsp = 1, nspec
-                chem_species(lsp)%conc_p(nzt+1,:,:) = chem_species(lsp)%conc(nzt+1,:,:)        
-             ENDDO
-          ELSEIF ( ibc_cs_t == 1 )  THEN
-             DO lsp = 1, nspec
-                chem_species(lsp)%conc_p(nzt+1,:,:) = chem_species(lsp)%conc_p(nzt,:,:)
-             ENDDO
-          ELSEIF ( ibc_cs_t == 2 )  THEN
-             DO lsp = 1, nspec
-                chem_species(lsp)%conc_p(nzt+1,:,:) = chem_species(lsp)%conc_p(nzt,:,:) + bc_cs_t_val(lsp) * dzu(nzt+1)
-             ENDDO
-                                    !@todo: bc_cs_t_val needs to be calculated,    
-                                    !see bc_pt_t_val = ( pt_init(nzt+1) - pt_init(nzt) ) / dzu(nzt+1) 
-                                    !(in time_integration). pt_init would be the counterpart to
-                                    !chem_species(i)%conc_pr_init (see kchem_driver_FKa1408.f90 of my 
-                                    !"Hints: prescribing initial concentration.
-          ENDIF
-!
-       CASE ( 'set_bc_lateral' )                       ! bK commented it
-!--          Lateral boundary conditions for chem species at inflow boundary
-!--          are automatically set when chem_species concentration is
-!--          initialized. The initially set value at the inflow boundary is not
-!--          touched during time integration, hence, this boundary value remains
-!--          at a constant value, which is the concentration that flows into the
-!--          domain.                                                           
-!--          Lateral boundary conditions for chem species at outflow boundary 
-
-          IF ( bc_radiation_s )  THEN
-             DO lsp = 1, nspec
-                chem_species(lsp)%conc_p(:,nys-1,:) = chem_species(lsp)%conc_p(:,nys,:)
-             ENDDO
-          ELSEIF ( bc_radiation_n )  THEN
-             DO lsp = 1, nspec
-                chem_species(lsp)%conc_p(:,nyn+1,:) = chem_species(lsp)%conc_p(:,nyn,:)
-             ENDDO
-          ELSEIF ( bc_radiation_l )  THEN
-             DO lsp = 1, nspec
-                chem_species(lsp)%conc_p(:,:,nxl-1) = chem_species(lsp)%conc_p(:,:,nxl)
-             ENDDO
-          ELSEIF ( bc_radiation_r )  THEN
-             DO lsp = 1, nspec
-                chem_species(lsp)%conc_p(:,:,nxr+1) = chem_species(lsp)%conc_p(:,:,nxr)
-             ENDDO
-          ENDIF
-         
-    END SELECT
-
- END SUBROUTINE chem_boundary_conds
-!
-!------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine defining initial vertical profiles of chemical species (given by
-!> namelist parameters chem_profiles and chem_heights)  --> which should work
-!> analogue to parameters u_profile, v_profile and uv_heights)
-!------------------------------------------------------------------------------!
- SUBROUTINE chem_init_profiles              !< SUBROUTINE is called from chem_init in case of 
-                                            !< TRIM( initializing_actions ) /= 'read_restart_data'
-                                            !< We still need to see what has to be done in case of restart run
-    USE chem_modules
-
-    IMPLICIT NONE
-
-!-- Local variables
-    INTEGER ::  lsp        !< running index for number of species in derived data type species_def
-    INTEGER ::  lsp_pr     !< running index for number of species in cs_names, cs_profiles etc
-    INTEGER ::  lpr_lev    !< running index for profile level for each chem spcs. 
-!    INTEGER ::  npr_lev    !< the next available profile lev
-
-!-----------------
-!-- To prescribe/initialize a vertically constant  'cs_profile', another parameter
-!-- "cs_surface" is introduced. If "cs_profile" and "cs_heights" are prescribed,
-!-- their values will override the constant profile given by "cs_surface".
-
-!     IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN 
-       lsp_pr = 1
-       DO  WHILE ( TRIM( cs_name( lsp_pr ) ) /= 'novalue' )   !'novalue' is the default
-          DO  lsp = 1, nspec                                !
-!--          Create initial profile (conc_pr_init) for each chemical species
-             IF ( TRIM( chem_species(lsp)%name ) == TRIM( cs_name(lsp_pr) ) )  THEN   !
-!                IF ( cs_profile(1,1) == 9999999.9_wp ) THEN
-!--               Set a vertically constant profile based on the surface conc (cs_surface(lsp_pr)) of each species
-                  DO lpr_lev = 0, nzt+1
-                     chem_species(lsp)%conc_pr_init(lpr_lev) = cs_surface(lsp_pr)
-                  ENDDO
-
-!                ELSE
-!                   IF ( cs_heights(lsp,1) /= 0.0_wp )  THEN
-!                      message_string = 'cs_heights(1,1) must be 0.0'
-!                      CALL message( 'chem_check_parameters', 'CM0012', 1, 2, 0, 6, 0 )
-!                   ENDIF
-!  
-!                   IF ( omega /= 0.0_wp )  THEN
-!                      message_string = 'Coriolis force must be switched off (by setting omega=0.0)' //  &
-!                                       ' when prescribing the forcing by u_profile and v_profile'
-!                      CALL message( 'check_parameters', 'PA0347', 1, 2, 0, 6, 0 )
-!                   ENDIF
-!  
-!                   use_prescribed_profile_data = .TRUE.
-! 
-!                   npr_lev = 1
-! !                  chem_sddpecies(lsp)%conc_pr_init(0) = 0.0_wp
-!                   DO  lpr_lev = 1, nz+1
-!                      IF ( npr_lev < 100 )  THEN
-!                         DO  WHILE ( cs_heights(lsp, npr_lev+1) <= zu(lpr_lev) )
-!                            npr_lev = npr_lev + 1
-!                            IF ( npr_lev == 100 )  EXIT
-!                         ENDDO
-!                      ENDIF
-!  
-!                      IF ( npr_lev < 100  .AND.  cs_heights(lsp, npr_lev + 1) /= 9999999.9_wp )  THEN
-!                         chem_species(lsp)%conc_pr_init(lpr_lev) = cs_profile(lsp, npr_lev) +         &
-!                                                 ( zu(lpr_lev) - cs_heights(lsp, npr_lev) ) /         &
-!                                                 ( cs_heights(lsp, npr_lev + 1) - cs_heights(lsp, npr_lev ) ) * &
-!                                                 ( cs_profile(lsp, npr_lev + 1) - cs_profile(lsp, npr_lev ) )
-!                      ELSE
-!                         chem_species(lsp)%conc_pr_init(lpr_lev) = cs_profile(lsp, npr_lev)
-!                      ENDIF
-!                   ENDDO
-!                ENDIF
-!-- If a profile is prescribed explicity using cs_profiles and cs_heights, we then have to fill the 
-!-- chem_species(lsp)%conc_pr_init for the specific "lsp" based on the cs_profiles(lsp_pr,:) 
-!-- and cs_heights(lsp_pr,:). 
+
+           ELSEIF ( decycle_method(boundary) == 'neumann' )  THEN
+!
+!--             The value at the boundary is copied to the ghost layers to simulate
+!--             an outlet with zero gradient
+                ss = 1
+                ee = 0
+                IF ( boundary == 1  .AND.  nxl == 0 )  THEN
+                   ss = nxlg
+                   ee = nxl-1
+                   copied = nxl
+                ELSEIF ( boundary == 2  .AND.  nxr == nx )  THEN
+                   ss = nxr+1
+                   ee = nxrg
+                   copied = nxr
+                ENDIF
+
+                 DO  i = ss, ee
+                   DO  j = nysg, nyng
+                      DO  k = nzb+1, nzt
+                         flag = MERGE( 1.0_wp, 0.0_wp,                            &
+                                       BTEST( wall_flags_0(k,j,i), 0 ) )
+                        cs_3d(k,j,i) = cs_3d(k,j,copied) * flag
+                      ENDDO
+                   ENDDO
+                ENDDO
+
+             ELSE
+                WRITE(message_string,*)                                           &
+                                    'unknown decycling method: decycle_method (', &
+                        boundary, ') ="' // TRIM( decycle_method(boundary) ) // '"'
+                CALL message( 'chem_boundary_conds_decycle', 'CM0431',           &
+                              1, 2, 0, 6, 0 )
              ENDIF
           ENDDO
-          lsp_pr = lsp_pr + 1
-       ENDDO
-!     ELSE
-!       IF (chem_debug1 ) print*,'code to be added for initializing_actions == read_restart_data'   !bK
-!     ENDIF
-
-!-- Now, go back to chem_init and use the contents of chem_species(lsp)%conc_pr_init to
-!-- initialize the 3D conc arrays, as it is currently taken care of in chem_set_constant_values.
-!-- After initializing the 3D arrays, these can be used to set the boundary conditions in the
-!-- subroutine kchem_boundary_conds, which should be called from boundary_conds.f90.
-
-
- END SUBROUTINE chem_init_profiles
-!
-!------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine initializating chemistry_model_mod
-!------------------------------------------------------------------------------!
-   SUBROUTINE chem_init
-
-      USE pegrid
-
-    IMPLICIT   none
-!-- local variables
-    INTEGER                 :: i,j               !< running index for for horiz numerical grid points
-    INTEGER                 :: lsp               !< running index for chem spcs
-    INTEGER                 :: lpr_lev           !< running index for chem spcs profile level
-!
-!-- NOPOINTER version not implemented yet
-! #if defined( __nopointer )
-!     message_string = 'The chemistry module only runs with POINTER version'
-!     CALL message( 'chemistry_model_mod', 'CM0001', 1, 2, 0, 6, 0 )      
-! #endif
-!
-!-- Allocate memory for chemical species
-    ALLOCATE( chem_species(nspec) )
-    ALLOCATE( spec_conc_1 (nzb:nzt+1,nysg:nyng,nxlg:nxrg,nspec) )
-    ALLOCATE( spec_conc_2 (nzb:nzt+1,nysg:nyng,nxlg:nxrg,nspec) )
-    ALLOCATE( spec_conc_3 (nzb:nzt+1,nysg:nyng,nxlg:nxrg,nspec) )
-    ALLOCATE( spec_conc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nspec) ) 
-    ALLOCATE( phot_frequen(nphot) ) 
-    ALLOCATE( freq_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nphot) )
-    ALLOCATE( bc_cs_t_val(nspec) )
-!
-!-- Initialize arrays
-    spec_conc_1 (:,:,:,:) = 0.0_wp
-    spec_conc_2 (:,:,:,:) = 0.0_wp
-    spec_conc_3 (:,:,:,:) = 0.0_wp
-    spec_conc_av(:,:,:,:) = 0.0_wp
-
-
-    DO lsp = 1, nspec
-       chem_species(lsp)%name    = spc_names(lsp)
-
-       chem_species(lsp)%conc   (nzb:nzt+1,nysg:nyng,nxlg:nxrg)       => spec_conc_1 (:,:,:,lsp)
-       chem_species(lsp)%conc_p (nzb:nzt+1,nysg:nyng,nxlg:nxrg)       => spec_conc_2 (:,:,:,lsp)
-       chem_species(lsp)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg)       => spec_conc_3 (:,:,:,lsp)
-       chem_species(lsp)%conc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg)       => spec_conc_av(:,:,:,lsp)     
-
-       ALLOCATE (chem_species(lsp)%cssws_av(nysg:nyng,nxlg:nxrg))                   
-       chem_species(lsp)%cssws_av    = 0.0_wp
-!
-!--    (todo (FK): This needs to be revised. This block must go somewhere else)                                         
-!      IF ( ws_scheme_sca )  THEN                                                
-          ALLOCATE (chem_species(lsp)%flux_s_cs(nzb+1:nzt,0:threads_per_task-1))   
-          ALLOCATE (chem_species(lsp)%diss_s_cs(nzb+1:nzt,0:threads_per_task-1))   
-          ALLOCATE (chem_species(lsp)%flux_l_cs(nzb+1:nzt,nys:nyn,0:threads_per_task-1)) 
-          ALLOCATE (chem_species(lsp)%diss_l_cs(nzb+1:nzt,nys:nyn,0:threads_per_task-1))   
-          chem_species(lsp)%flux_s_cs = 0.0_wp                                     
-          chem_species(lsp)%flux_l_cs = 0.0_wp                                     
-          chem_species(lsp)%diss_s_cs = 0.0_wp                                      
-          chem_species(lsp)%diss_l_cs = 0.0_wp                                     
-!      ENDIF         
-!
-!--   Allocate memory for initial concentration profiles
-!--   (concentration values come from namelist)
-!--   (todo (FK): Because of this, chem_init is called in palm before
-!--               check_parameters, since conc_pr_init is used there.
-!--               We have to find another solution since chem_init should
-!--               eventually be called from init_3d_model!!)
-      ALLOCATE ( chem_species(lsp)%conc_pr_init(0:nz+1) )
-      chem_species(lsp)%conc_pr_init(:) = 0.0_wp
-
-    ENDDO
-
-!
-!-- Set initial concentration of profiles prescribed by parameters cs_profile
-!-- and cs_heights in the namelist &chemistry_parameters
-!-- (todo (FK): chem_init_profiles not ready yet, has some bugs)
-!     CALL chem_init_profiles
-!
-!-- Initialize model variables
-
-
-    IF ( TRIM( initializing_actions ) /= 'read_restart_data'  .AND.            &
-         TRIM( initializing_actions ) /= 'cyclic_fill' )  THEN
-
-
-!--    First model run of a possible job queue.
-!--    Initial profiles of the variables must be computes.
-       IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
-!            CALL location_message( 'initializing with 1D model profiles', .FALSE. )
-!
-!          CALL init_1d_model    ...... decide to call or not later     !bK
-
-!--        Transfer initial profiles to the arrays of the 3D model
-          DO lsp = 1, nspec
-             DO  i = nxlg, nxrg
-                DO  j = nysg, nyng
-                   DO lpr_lev = 1, nz + 1
-                      chem_species(lsp)%conc(lpr_lev,j,i) = chem_species(lsp)%conc_pr_init(lpr_lev)
+       ENDIF
+
+       
+!--    South and north boundaries
+       IF ( decycle_chem_ns  .AND.  bc_ns_cyc )  THEN
+
+          DO  boundary = 3, 4
+
+             IF ( decycle_method(boundary) == 'dirichlet' )  THEN
+!    
+!--             Initial profile is copied to ghost and first three layers          
+                ss = 1
+                ee = 0
+                IF ( boundary == 3  .AND.  nys == 0 )  THEN
+                   ss = nysg
+                   ee = nys+2
+                ELSEIF ( boundary == 4  .AND.  nyn == ny )  THEN
+                   ss = nyn-2
+                   ee = nyng
+                ENDIF
+
+                DO  i = nxlg, nxrg
+                   DO  j = ss, ee
+                      DO  k = nzb+1, nzt
+                         flag = MERGE( 1.0_wp, 0.0_wp,                            &
+                                       BTEST( wall_flags_0(k,j,i), 0 ) )
+                         cs_3d(k,j,i) = cs_pr_init(k) * flag
+                      ENDDO
                    ENDDO
                 ENDDO
-             ENDDO   
+       
+       
+           ELSEIF ( decycle_method(boundary) == 'neumann' )  THEN
+!
+!--             The value at the boundary is copied to the ghost layers to simulate
+!--             an outlet with zero gradient
+                ss = 1
+                ee = 0
+                IF ( boundary == 3  .AND.  nys == 0 )  THEN
+                   ss = nysg
+                   ee = nys-1
+                   copied = nys
+                ELSEIF ( boundary == 4  .AND.  nyn == ny )  THEN
+                   ss = nyn+1
+                   ee = nyng
+                   copied = nyn
+                ENDIF
+
+                 DO  i = nxlg, nxrg
+                   DO  j = ss, ee
+                      DO  k = nzb+1, nzt
+                         flag = MERGE( 1.0_wp, 0.0_wp,                            &
+                                       BTEST( wall_flags_0(k,j,i), 0 ) )
+                         cs_3d(k,j,i) = cs_3d(k,copied,i) * flag
+                      ENDDO
+                   ENDDO
+                ENDDO
+
+             ELSE
+                WRITE(message_string,*)                                           &
+                                    'unknown decycling method: decycle_method (', &
+                        boundary, ') ="' // TRIM( decycle_method(boundary) ) // '"'
+                CALL message( 'chem_boundary_conds_decycle', 'CM0432',           &
+                              1, 2, 0, 6, 0 )
+             ENDIF
           ENDDO
-       
-       ELSEIF ( INDEX(initializing_actions, 'set_constant_profiles') /= 0 )    &
-       THEN
-!           CALL location_message( 'initializing with constant profiles', .FALSE. )
-
-
-
-!--       Set initial horizontal velocities at the lowest computational grid 
-!--       levels to zero in order to avoid too small time steps caused by the 
-!--       diffusion limit in the initial phase of a run (at k=1, dz/2 occurs
-!--       in the limiting formula!).
-
-          DO lsp = 1, nspec 
-             DO  i = nxlg, nxrg
-                DO  j = nysg, nyng
-                   chem_species(lsp)%conc(:,j,i) = chem_species(lsp)%conc_pr_init    !ITS THERE bK
-                ENDDO
-             ENDDO
-          ENDDO
-
-!        ELSEIF ( INDEX(initializing_actions, 'by_user') /= 0 )                  &
-!        THEN
-!           CALL location_message( 'initializing by user', .FALSE. )
-!
-!--       Initialization will completely be done by the user
-!--       (FK: This should be called only once, in init_3d_model, i.e. remove it here)
-!           CALL user_init_3d_model
-!           CALL location_message( 'finished', .TRUE. )
-
        ENDIF
-
-!-- Store initial chem spcs profile
-!         DO lsp = 1, nvar
-!          hom_cs(:,1,115,:) = SPREAD(  chem_species(lsp)%conc(:,nys,nxl), 2, statistic_regions+1 )
-!         ENDDO
-!
-!-- If required, change the surface chem spcs at the start of the 3D run
-       IF ( cs_surface_initial_change(1) /= 0.0_wp ) THEN            
-          DO lsp = 1, nspec 
-             chem_species(lsp)%conc(nzb,:,:) = chem_species(lsp)%conc(nzb,:,:) +  &
-                                               cs_surface_initial_change(lsp)
-          ENDDO
-       ENDIF 
-!
-!-- Initiale old and new time levels. 
-       DO lsp = 1, nvar
-          chem_species(lsp)%tconc_m = 0.0_wp                      
-          chem_species(lsp)%conc_p  = chem_species(lsp)%conc     
-       ENDDO
-
-    ENDIF
-
-
-
-!--- new code add above this line
-    DO lsp = 1, nphot
-       phot_frequen(lsp)%name = phot_names(lsp)
-!        IF( myid == 0 )  THEN
-!           WRITE(6,'(a,i4,3x,a)')  'Photolysis: ',lsp,trim(phot_names(lsp))
-!        ENDIF 
-         phot_frequen(lsp)%freq(nzb:nzt+1,nysg:nyng,nxlg:nxrg)    => freq_1(:,:,:,lsp)
-    ENDDO
-
-!--   Set initial values
-!    Not required any more, this can now be done with the namelist  by setting cs_surface 
-!    and cs_name without specifying cs_profile (Nevertheless, we still want to keep it for a while) 
-!   IF (  TRIM( initializing_actions ) /= 'read_restart_data' )  THEN             
-!         CALL set_const_initial_values
-!   ENDIF
-
-    RETURN
-
-    CONTAINS
-!------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine setting constant initial values of chemical species
-!------------------------------------------------------------------------------!
-     SUBROUTINE set_const_initial_values
-!    Not required any more, this can now be done with the namelist  by setting cs_surface 
-!    and cs_name without specifying cs_profile (Nevertheless, we still want to keep it for a while) 
-         IMPLICIT   none
-
-!--      local variables
-         INTEGER                  :: lsp
-
-         IF(myid == 0)  THEN
-            write(6,'(/,a,/)')  ' chemics >>>> Set constant Initial Values: '
-         ENDIF
-
-!        Default values are taken from smog.def from supplied kpp example
-         DO lsp = 1, nspec
-            IF(trim(chem_species(lsp)%name) == 'NO')           THEN
-!              chem_species(lsp)%conc = 8.725*1.0E+08
-!              chem_species(lsp)%conc = 0.05_wp                          !added by bK
-               chem_species(lsp)%conc = 0.01_wp                          !added by RFo
-            ELSEIF (trim(chem_species(lsp)%name) == 'NO2')     THEN
-!              chem_species(lsp)%conc = 2.240*1.0E+08             
-!              chem_species(lsp)%conc = 0.01_wp                          !added by bK
-               chem_species(lsp)%conc = 0.05_wp                          !added by RFo
-            ELSEIF( trim( chem_species(lsp)%name ) == 'O3' )   THEN
-               chem_species(lsp)%conc = 0.05_wp                          !added by bK
-            ELSEIF(trim(chem_species(lsp)%name) == 'H2O')      THEN
-!              chem_species(lsp)%conc = 5.326*1.0E+11
-               chem_species(lsp)%conc = 1.30*1.0E+4_wp                   !added by bK
-            ELSEIF(trim(chem_species(lsp)%name) == 'O2')       THEN
-               chem_species(lsp)%conc = 2.0*1.0E+5_wp                    !added by bK
-            ELSEIF(trim(chem_species(lsp)%name) == 'RH')       THEN
-               chem_species(lsp)%conc = 0.001_wp                         !added by RFo
-            ELSEIF(trim(chem_species(lsp)%name) == 'CO')       THEN
-               chem_species(lsp)%conc = 0.5_wp                           !added by RFo
-            ELSEIF(trim(chem_species(lsp)%name) == 'RCHO')     THEN
-!              chem_species(lsp)%conc = 2.0_wp                           !added by bK
-               chem_species(lsp)%conc = 0.01_wp                          !added by RFo
-!           ELSEIF(trim(chem_species(lsp)%name) == 'OH')       THEN
-!              chem_species(lsp)%conc = 1.0*1.0E-07_wp                   !added by bK
-!           ELSEIF(trim(chem_species(lsp)%name) == 'HO2')      THEN
-!              chem_species(lsp)%conc = 1*1.0E-7_wp                      !added by bK
-!           ELSEIF(trim(chem_species(lsp)%name) == 'RCOO2')    THEN      ! corrected RFo
-!              chem_species(lsp)%conc = 1.0*1.0E-7_wp                    !added by bK
-!           ELSEIF(trim(chem_species(lsp)%name) == 'RCOO2NO2') THEN
-!              chem_species(lsp)%conc = 1.0*1.0E-7_wp                    !added by bK
-            ELSE
-!              H2O = 2.0e+04;
-               chem_species(lsp)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) = 0.0_wp
-            ENDIF
-
-            IF(myid == 0)  THEN
-               WRITE(6,'(a,3x,a,3x,a,e12.4)')  '   Species:     ',chem_species(lsp)%name(1:7), & 
-                                        'Initial Value = ',chem_species(lsp)%conc(nzb,nysg,nxlg)
-            ENDIF
-         ENDDO
-
-!   #if defined( __nopointer )
-!   !kk      Hier mit message abbrechen
-!            if(myid == 0)  then
-!               write(6,*)  '   KPP does only run with POINTER Version'
-!            end if
-!            stop 'error'
-!   #endif
-
-         RETURN
-      END SUBROUTINE set_const_initial_values
-
-
-   END SUBROUTINE chem_init
-!
-!------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine defining parin for &chemistry_parameters for chemistry model
-!------------------------------------------------------------------------------!
-   SUBROUTINE chem_parin
-   
-      USE control_parameters,                                                  &
-          ONLY: air_chemistry
-          
-      USE chem_modules
-      
-      USE kinds
-
-      IMPLICIT   none
-
-      CHARACTER (LEN=80) ::  line   !< dummy string that contains the current line of the parameter file
-      
-      REAL(wp), DIMENSION(nmaxfixsteps) ::   my_steps   !< List of fixed timesteps   my_step(1) = 0.0 automatic stepping
-
-      NAMELIST /chemistry_parameters/   bc_cs_b,                          &
-                                        bc_cs_t,                          &
-                                        call_chem_at_all_substeps,        &
-                                        chem_debug0,                      &
-                                        chem_debug1,                      &
-                                        chem_debug2,                      &
-                                        chem_gasphase_on,                 &
-                                        cs_heights,                       &
-                                        cs_name,                          &
-                                        cs_profile,                       &
-                                        cs_profile_name,                  & 
-                                        cs_surface,                       &
-                                        emiss_factor_main,                &
-                                        emiss_factor_side,                &                      
-                                        icntrl,                           &
-                                        main_street_id,                   &
-                                        max_street_id,                    &
-                                        my_steps,                         &
-                                        nest_chemistry,                   &
-                                        rcntrl,                           &
-                                        side_street_id,                   &
-                                        photolysis_scheme,                &
-                                        wall_csflux,                      &
-                                        cs_vertical_gradient,             &
-                                        top_csflux,                       & 
-                                        surface_csflux,                   &
-                                        surface_csflux_name,              &
-                                        cs_surface_initial_change,        &
-                                        cs_vertical_gradient_level
-                             
-!-- analogue to chem_names(nspj) we could invent chem_surfaceflux(nspj) and chem_topflux(nspj)
-!-- so this way we could prescribe a specific flux value for each species
-!>  chemistry_parameters for initial profiles
-!>  cs_names = 'O3', 'NO2', 'NO', ...   to set initial profiles)
-!>  cs_heights(1,:) = 0.0, 100.0, 500.0, 2000.0, .... (height levels where concs will be prescribed for O3)
-!>  cs_heights(2,:) = 0.0, 200.0, 400.0, 1000.0, .... (same for NO2 etc.) 
-!>  cs_profiles(1,:) = 10.0, 20.0, 20.0, 30.0, .....  (chem spcs conc at height lvls chem_heights(1,:)) etc.
-!>  If the respective concentration profile should be constant with height, then use "cs_surface( number of spcs)"
-!>  then write these cs_surface values to chem_species(lsp)%conc_pr_init(:)
-
-!
-!--   Read chem namelist   
-!--   (todo: initialize these parameters in declaration part, do this for
-!--          all chemistry_parameters namelist parameters)
-      icntrl    = 0
-      rcntrl    = 0.0_wp
-      my_steps  = 0.0_wp
-      icntrl(2) = 1                                  
-      photolysis_scheme = 'simple'
-      atol = 1.0_wp
-      rtol = 0.01_wp
-!
-!--   Try to find chemistry package
-      REWIND ( 11 )
-      line = ' '
-      DO WHILE ( INDEX( line, '&chemistry_parameters' ) == 0 )
-         READ ( 11, '(A)', END=20 )  line
-      ENDDO
-      BACKSPACE ( 11 )
-!
-!--   Read chemistry namelist
-      READ ( 11, chemistry_parameters, ERR = 10, END = 20 )
-!
-!--   Enable chemistry model
-      air_chemistry = .TRUE.
-      GOTO 20
-
- 10   BACKSPACE( 11 )
-      READ( 11 , '(A)') line
-      CALL parin_fail_message( 'chemistry_parameters', line )
-
- 20   CONTINUE
-
-      t_steps = my_steps          !(todo: Why not directly make t_steps a
-                                  !       namelist parameter?)
-
-   END SUBROUTINE chem_parin
-
- !
-!------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine to integrate chemical species in the given chemical mechanism
-!------------------------------------------------------------------------------!
-
-   SUBROUTINE chem_integrate_ij (i, j)
-
-      USE cpulog,                                                              &
-           ONLY: cpu_log, log_point
-      USE statistics,                                                          &   ! ## RFo
-           ONLY:  weight_pres
-       USE control_parameters,                                                 &   ! ## RFo 
-           ONLY:  dt_3d, intermediate_timestep_count
-
-      IMPLICIT   none
-      INTEGER,INTENT(IN)       :: i,j
-
-!--   local variables
-      INTEGER(iwp) ::  lsp                                                          !< running index for chem spcs.
-      INTEGER(iwp) ::  lph                                                          !< running index for photolysis frequencies
-      INTEGER                  :: istatf
-      INTEGER,dimension(20)    :: istatus
-      REAL(kind=wp),dimension(nzb+1:nzt,nspec)                :: tmp_conc           
-      REAL(kind=wp),dimension(nzb+1:nzt)                      :: tmp_temp
-      REAL(kind=wp),dimension(nzb+1:nzt,nphot)                :: tmp_phot
-      REAL(kind=wp),dimension(nzb+1:nzt)                      :: tmp_fact   
-     REAL(kind=wp),dimension(nzb+1:nzt)                      :: tmp_fact_i    !< conversion factor between molecules cm^{-3} and ppm
-     REAL(wp)                         ::  conv                                !< conversion factor
-     REAL(wp), PARAMETER              ::  ppm2fr  = 1.0e-6_wp                 !< Conversion factor ppm to fraction
-     REAL(wp), PARAMETER              ::  t_std   = 273.15_wp                 !< standard pressure (Pa)
-     REAL(wp), PARAMETER              ::  p_std   = 101325.0_wp               !< standard pressure (Pa)
-     REAL(wp), PARAMETER              ::  vmolcm  = 22.414e3_wp               !< Mole volume (22.414 l) in cm^{-3}
-     REAL(wp), PARAMETER              ::  xna     = 6.022e23_wp               !< Avogadro number (molecules/mol)
-
-
-      REAL(kind=wp)  :: dt_chem                                             
-
-       CALL cpu_log( log_point(80), '[chem_integrate_ij]', 'start' )
-!<     Set chem_gasphase_on to .FALSE. if you want to skip computation of gas phase chemistry
-    IF (chem_gasphase_on) THEN
-
-       tmp_temp(:) = pt(:,j,i) * exner(nzb+1:nzt)
-! ppm to molecules/cm**3
-!      tmp_fact = 1.e-6_wp*6.022e23_wp/(22.414_wp*1000._wp) * 273.15_wp * hyp(nzb+1:nzt)/( 101300.0_wp * tmp_temp )
-       conv = ppm2fr * xna / vmolcm
-       tmp_fact(:) = conv * t_std * hyp(nzb+1:nzt) / (tmp_temp(:) * p_std)
-       tmp_fact_i = 1.0_wp/tmp_fact
-
-       CALL fill_temp (istatf, tmp_temp)                                      !< Load constant temperature into kpp context
-!      CALL fill_temp (istatf, pt(nzb+1:nzt,j,i))                             !< Load temperature into kpp context
-
-       DO lsp = 1,nspec
-          tmp_conc(:,lsp) = chem_species(lsp)%conc(nzb+1:nzt,j,i) * tmp_fact(:) 
-       ENDDO
-
-       DO lph = 1,nphot
-          tmp_phot(:,lph) = phot_frequen(lph)%freq(nzb+1:nzt,j,i)               
-       ENDDO
-
-       IF(myid == 0 .AND. chem_debug0 ) THEN
-          IF (i == 10 .and. j == 10) WRITE(0,*) 'begin chemics step ',dt_3d
-       ENDIF
-
-!--    Compute length of time step     # RFo
-       IF ( call_chem_at_all_substeps )  THEN
-          dt_chem = dt_3d * weight_pres(intermediate_timestep_count)
-       ELSE
-          dt_chem = dt_3d
-       ENDIF
-
-       CALL cpu_log( log_point(81), '{chem_gasphase_integrate}', 'start' )
-
-
-       CALL chem_gasphase_integrate (dt_chem, tmp_conc, tmp_temp, tmp_phot, istatus=istatus)
-
-
-       CALL cpu_log( log_point(81), '{chem_gasphase_integrate}', 'stop' )
-
-       DO lsp = 1,nspec
-          chem_species(lsp)%conc (nzb+1:nzt,j,i) = tmp_conc(:,lsp) * tmp_fact_i(:)  ! RFo
-       ENDDO
-
-!      IF (myid == 0 .AND. chem_debug2 ) THEN 
-!         IF (i == 10 .and. j == 10)   WRITE(6,'(a,8i7)') ' KPP Status ',istatus(1:8)
-!         write(6,'(a,8i7)') ' KPP Status ',istatus(1:8)
-!      ENDIF
-
-    ENDIF
-       CALL cpu_log( log_point(80), '[chem_integrate_ij]', 'stop' )
-
-       RETURN
-   END SUBROUTINE chem_integrate_ij
-!
-!------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine for swapping of timelevels for chemical species
-!> called out from subroutine swap_timelevel
-!------------------------------------------------------------------------------!
-
-   SUBROUTINE chem_swap_timelevel (level)
-      IMPLICIT   none
-
-      INTEGER,INTENT(IN)                  :: level
-
-!--   local variables
-
-      INTEGER               :: lsp
-
-!        print*,' *** entering chem_swap_timelevel ***) '
-      if(level == 0)  then
-         do lsp=1, nvar                                       
-            chem_species(lsp)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)    => spec_conc_1(:,:,:,lsp)
-            chem_species(lsp)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  => spec_conc_2(:,:,:,lsp)
-         end do
-      else
-         do lsp=1, nvar                                        
-            chem_species(lsp)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)    => spec_conc_2(:,:,:,lsp)
-            chem_species(lsp)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  => spec_conc_1(:,:,:,lsp)
-         end do
-      end if
-
-      RETURN
-   END SUBROUTINE chem_swap_timelevel
-
-!------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine defining appropriate grid for netcdf variables.
-!> It is called out from subroutine netcdf.
-!------------------------------------------------------------------------------!
-   SUBROUTINE chem_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
-
-      IMPLICIT NONE
-
-      CHARACTER (LEN=*), INTENT(IN)  ::  var         !<
-      LOGICAL, INTENT(OUT)           ::  found       !<
-      CHARACTER (LEN=*), INTENT(OUT) ::  grid_x      !<
-      CHARACTER (LEN=*), INTENT(OUT) ::  grid_y      !<
-      CHARACTER (LEN=*), INTENT(OUT) ::  grid_z      !<
-
-      found  = .TRUE.
-
-      if(var(1:3) == 'kc_')   then                    !< always the same grid for chemistry variables
-            grid_x = 'x'
-            grid_y = 'y'
-            grid_z = 'zu'                             !< kk Use same z axis as u variables. Has to be checked if OK
-      else
-            found  = .FALSE.
-            grid_x = 'none'
-            grid_y = 'none'
-            grid_z = 'none'
-      end if
-
-!     write(6,*) 'chem_define_netcdf_grid ',TRIM(var),' ',trim(grid_x),' ',found
-
-   END SUBROUTINE chem_define_netcdf_grid
-!
+    END SUBROUTINE chem_boundary_conds_decycle
+   !
 !------------------------------------------------------------------------------!
 !
@@ -1068,40 +784,46 @@
 !------------------------------------------------------------------------------!
 
-   SUBROUTINE chem_check_data_output( var, unit, i, ilen, k )
-
-      IMPLICIT NONE
-
-      CHARACTER (LEN=*) ::  unit     !<
-      CHARACTER (LEN=*) ::  var      !<
-
-      INTEGER(iwp) ::  i, ilen, k, lsp
-
-      CHARACTER(len=16)    ::  spec_name
-
-      unit = 'illegal'
-
-      spec_name = TRIM(var(4:))             !< var 1:3 is 'kc_'.
-
-       DO lsp=1,nspec
-         IF (TRIM(spec_name) == TRIM(chem_species(lsp)%name))   THEN
-            unit = 'ppm'
-         ENDIF
-         ! It is possible  to plant PM10 and PM25 into the gasphase chemistry code 
-!        ! as passive species (e.g. 'passive' in GASPHASE_PREPROC/mechanisms):
-!        ! set unit to micrograms per m**3 for PM10 and PM25 (PM2.5)
-         IF (spec_name(1:2) == 'PM')   THEN  
-            unit = 'ug m-3'
-         ENDIF
-       ENDDO
-
-       DO lsp=1,nphot                                                     
-         IF (TRIM(spec_name) == TRIM(phot_frequen(lsp)%name))   THEN
-            unit = 'sec-1'
-         ENDIF
-       ENDDO
+    SUBROUTINE chem_check_data_output( var, unit, i, ilen, k )
+
+
+       USE control_parameters,                                                 &
+          ONLY: data_output, message_string
+
+       IMPLICIT NONE
+
+       CHARACTER (LEN=*) ::  unit     !<
+       CHARACTER (LEN=*) ::  var      !<
+
+       INTEGER(iwp) :: i, lsp
+       INTEGER(iwp) :: ilen
+       INTEGER(iwp) :: k
+
+       CHARACTER(len=16)    ::  spec_name
+
+       unit = 'illegal'
+
+       spec_name = TRIM(var(4:))             !< var 1:3 is 'kc_'.
+
+          DO lsp=1,nspec
+             IF (TRIM(spec_name) == TRIM(chem_species(lsp)%name))   THEN
+                unit = 'ppm'
+             ENDIF
+!            It is possible  to plant PM10 and PM25 into the gasphase chemistry code 
+!            as passive species (e.g. 'passive' in GASPHASE_PREPROC/mechanisms):
+!            set unit to micrograms per m**3 for PM10 and PM25 (PM2.5)
+             IF (spec_name(1:2) == 'PM')   THEN  
+            unit = 'kg m-3'
+             ENDIF
+          ENDDO
+
+          DO lsp=1,nphot                                                     
+             IF (TRIM(spec_name) == TRIM(phot_frequen(lsp)%name))   THEN
+                unit = 'sec-1'
+             ENDIF
+          ENDDO
 
 
        RETURN
-   END SUBROUTINE chem_check_data_output
+    END SUBROUTINE chem_check_data_output
 !
 !------------------------------------------------------------------------------!
@@ -1112,49 +834,222 @@
 !------------------------------------------------------------------------------!
 
-   SUBROUTINE chem_check_data_output_pr( variable, var_count, unit, dopr_unit )
-
-
-    USE arrays_3d,                                                             &
-        ONLY: zu
-
-    USE control_parameters,                                                    &
-        ONLY: data_output_pr, message_string, air_chemistry
-
-    USE indices
-
-    USE profil_parameter
-
-    USE statistics
-
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=*) ::  unit     !< 
-    CHARACTER (LEN=*) ::  variable !< 
-    CHARACTER (LEN=*) ::  dopr_unit
-    CHARACTER(len=16) ::  spec_name
- 
-    INTEGER(iwp) ::  var_count, lsp  !<
+    SUBROUTINE chem_check_data_output_pr( variable, var_count, unit, dopr_unit )
+
+       USE arrays_3d
+       USE control_parameters,                                                    &
+           ONLY: data_output_pr, message_string, air_chemistry
+       USE indices
+       USE profil_parameter
+       USE statistics
+
+
+       IMPLICIT NONE
+
+       CHARACTER (LEN=*) ::  unit     !< 
+       CHARACTER (LEN=*) ::  variable !< 
+       CHARACTER (LEN=*) ::  dopr_unit
+       CHARACTER(len=16) ::  spec_name
     
-
-    spec_name = TRIM(variable(4:))    
-!             write(9,*) 'fm #32 .. air_chemistry ', air_chemistry
+       INTEGER(iwp) ::  var_count, lsp  !<
+       
+
+       spec_name = TRIM(variable(4:))    
 
           IF (  .NOT.  air_chemistry )  THEN
-                 message_string = 'data_output_pr = ' //                        &
-                 TRIM( data_output_pr(var_count) ) // ' is not imp' // &
-                          'lemented for air_chemistry = .FALSE.'
-!                CALL message( 'check_parameters', 'PA0XXX', 1, 2, 0, 6, 0 )
+             message_string = 'data_output_pr = ' //                        &
+             TRIM( data_output_pr(var_count) ) // ' is not imp' // &
+                         'lemented for air_chemistry = .FALSE.'
+             CALL message( 'chem_check_parameters', 'CM0433', 1, 2, 0, 6, 0 )              
+
           ELSE
              DO lsp = 1, nspec
                 IF (TRIM( spec_name ) == TRIM( chem_species(lsp)%name ) ) THEN 
-                    dopr_index(var_count) = 900 
-                    dopr_unit  = 'ppm'
-                    hom(:,2,900,:) = SPREAD( zu, 2, statistic_regions+1 )
+                   cs_pr_count = cs_pr_count+1
+                   cs_pr_index(cs_pr_count) = lsp
+                   dopr_index(var_count) = pr_palm+cs_pr_count  
+                   dopr_unit  = 'ppm'
+                   IF (spec_name(1:2) == 'PM')   THEN
+                        dopr_unit = 'kg m-3'
+                   ENDIF
+                      hom(:,2, dopr_index(var_count),:) = SPREAD( zu, 2, statistic_regions+1 )
+                      unit = dopr_unit  
                 ENDIF
              ENDDO
           ENDIF
 
-   END SUBROUTINE chem_check_data_output_pr
+    END SUBROUTINE chem_check_data_output_pr
+
+!
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Check parameters routine for chemistry_model_mod
+!------------------------------------------------------------------------------!
+    SUBROUTINE chem_check_parameters
+
+       IMPLICIT NONE
+
+       LOGICAL                        ::  found
+       INTEGER (iwp)                  ::  lsp_usr      !< running index for user defined chem spcs 
+       INTEGER (iwp)                  ::  lsp          !< running index for chem spcs.
+
+
+!!--   check for chemical reactions status
+       IF ( chem_gasphase_on )  THEN
+          message_string = 'Chemical reactions: ON'
+          CALL message( 'chem_check_parameters', 'CM0421', 0, 0, 0, 6, 0 )
+       ELSEIF ( .not. (chem_gasphase_on) ) THEN
+          message_string = 'Chemical reactions: OFF'
+          CALL message( 'chem_check_parameters', 'CM0422', 0, 0, 0, 6, 0 )
+       ENDIF
+
+!--    check for chemistry time-step
+       IF ( call_chem_at_all_substeps )  THEN
+          message_string = 'Chemistry is calculated at all meteorology time-step'
+          CALL message( 'chem_check_parameters', 'CM0423', 0, 0, 0, 6, 0 )
+       ELSEIF ( .not. (call_chem_at_all_substeps) ) THEN
+          message_string = 'Sub-time-steps are skipped for chemistry time-steps'
+          CALL message( 'chem_check_parameters', 'CM0424', 0, 0, 0, 6, 0 )
+       ENDIF
+
+!--    check for photolysis scheme 
+       IF ( (photolysis_scheme /= 'simple') .AND. (photolysis_scheme /= 'constant')  )  THEN
+          message_string = 'Incorrect photolysis scheme selected, please check spelling'
+          CALL message( 'chem_check_parameters', 'CM0425', 1, 2, 0, 6, 0 )
+       ENDIF
+
+!--    check for  decycling of chem species
+       IF ( (.not. any(decycle_method == 'neumann') ) .AND. (.not. any(decycle_method == 'dirichlet') ) )   THEN
+          message_string = 'Incorrect boundary conditions. Only neumann or dirichlet     &
+          available for decycling chemical species ' 
+          CALL message( 'chem_check_parameters', 'CM0426', 1, 2, 0, 6, 0 )
+       ENDIF
+
+!--    check for initial chem species input
+       lsp_usr = 1
+       lsp     = 1
+       DO WHILE ( cs_name (lsp_usr) /= 'novalue')
+          found = .FALSE.
+          DO lsp = 1, nvar
+             IF ( TRIM(cs_name (lsp_usr)) == TRIM(chem_species(lsp)%name) ) THEN
+                found = .TRUE.
+                EXIT
+             ENDIF 
+          ENDDO
+          IF ( .not. found ) THEN
+             message_string = 'Incorrect input for initial surface vaue: ' // TRIM(cs_name(lsp_usr))
+             CALL message( 'chem_check_parameters', 'CM0427', 0, 1, 0, 6, 0 )
+          ENDIF
+          lsp_usr = lsp_usr + 1
+       ENDDO
+
+!--    check for surface  emission flux chem species
+
+       lsp_usr = 1
+       lsp     = 1
+       DO WHILE ( surface_csflux_name (lsp_usr) /= 'novalue')
+          found = .FALSE.
+          DO lsp = 1, nvar
+             IF ( TRIM(surface_csflux_name (lsp_usr)) == TRIM(chem_species(lsp)%name) ) THEN
+                found = .TRUE.
+                EXIT
+             ENDIF 
+          ENDDO
+          IF ( .not. found ) THEN
+             message_string = 'Incorrect input of chemical species for surface emission fluxes: '  &
+                               // TRIM(surface_csflux_name(lsp_usr))
+             CALL message( 'chem_check_parameters', 'CM0428', 0, 1, 0, 6, 0 )
+          ENDIF
+          lsp_usr = lsp_usr + 1
+       ENDDO
+
+    END SUBROUTINE chem_check_parameters
+
+!
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine defining 2D output variables for chemical species
+!> @todo: Remove "mode" from argument list, not used.
+!------------------------------------------------------------------------------!
+    
+    SUBROUTINE chem_data_output_2d( av, variable, found, grid, mode, local_pf,   &
+                                     two_d, nzb_do, nzt_do, fill_value )
+    
+       USE indices
+
+       USE kinds
+
+       USE pegrid,             ONLY: myid, threads_per_task
+
+       IMPLICIT NONE
+
+       CHARACTER (LEN=*) ::  grid       !<
+       CHARACTER (LEN=*) ::  mode       !< 
+       CHARACTER (LEN=*) ::  variable   !< 
+       INTEGER(iwp) ::  av              !< flag to control data output of instantaneous or time-averaged data
+       INTEGER(iwp) ::  nzb_do          !< lower limit of the domain (usually nzb)
+       INTEGER(iwp) ::  nzt_do          !< upper limit of the domain (usually nzt+1)
+       LOGICAL      ::  found           !< 
+       LOGICAL      ::  two_d           !< flag parameter that indicates 2D variables (horizontal cross sections)
+       REAL(wp)     ::  fill_value 
+       REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb:nzt+1) ::  local_pf !< 
+
+       !-- local variables.
+       CHARACTER(len=16)    ::  spec_name
+       INTEGER(iwp) ::  lsp
+       INTEGER(iwp) ::  i               !< grid index along x-direction
+       INTEGER(iwp) ::  j               !< grid index along y-direction
+       INTEGER(iwp) ::  k               !< grid index along z-direction
+       INTEGER(iwp) ::  m               !< running index surface elements
+       INTEGER(iwp) ::  char_len        !< length of a character string
+       found = .TRUE.
+       char_len  = LEN_TRIM(variable)
+
+       spec_name = TRIM( variable(4:char_len-3) )
+
+          DO lsp=1,nspec
+             IF (TRIM(spec_name) == TRIM(chem_species(lsp)%name)    .AND.                             &
+                   ( (variable(char_len-2:) == '_xy')               .OR.                              &
+                     (variable(char_len-2:) == '_xz')               .OR.                              &
+                     (variable(char_len-2:) == '_yz') ) )               THEN             
+
+                   IF(myid == 0)  WRITE(6,*) 'Output of species ' // TRIM(variable)  //               &
+                                                            TRIM(chem_species(lsp)%name)       
+                IF (av == 0) THEN
+                   DO  i = nxl, nxr
+                      DO  j = nys, nyn
+                         DO  k = nzb_do, nzt_do
+                              local_pf(i,j,k) = MERGE(                                                &
+                                                 chem_species(lsp)%conc(k,j,i),                       &
+                                                 REAL( fill_value, KIND = wp ),                       &
+                                                 BTEST( wall_flags_0(k,j,i), 0 ) )
+
+
+                         ENDDO
+                      ENDDO
+                   ENDDO
+              
+                ELSE
+                   DO  i = nxl, nxr
+                      DO  j = nys, nyn
+                         DO  k = nzb_do, nzt_do
+                              local_pf(i,j,k) = MERGE(                                                &
+                                                 chem_species(lsp)%conc(k,j,i),                       &
+                                                 REAL( fill_value, KIND = wp ),                       &
+                                                 BTEST( wall_flags_0(k,j,i), 0 ) )
+                         ENDDO
+                      ENDDO
+                   ENDDO
+                ENDIF
+                 grid = 'zu'           
+             ENDIF
+          ENDDO
+
+          RETURN
+     
+    END SUBROUTINE chem_data_output_2d      
+
 !
 !------------------------------------------------------------------------------!
@@ -1165,37 +1060,34 @@
 !------------------------------------------------------------------------------!
 
-
-   SUBROUTINE chem_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
-
-
-      USE indices
-
-      USE kinds
-
-
-      IMPLICIT NONE
-
-      CHARACTER (LEN=*) ::  variable !<
-
-      INTEGER(iwp) ::  av    !<
-      INTEGER(iwp) ::  nzb_do !< lower limit of the data output (usually 0)
-      INTEGER(iwp) ::  nzt_do !< vertical upper limit of the data output (usually nz_do3d)
-
-      LOGICAL      ::  found !<
-
-      REAL(wp) ::  fill_value !<
-      REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf 
-
-
-      !-- local variables
-
-      INTEGER              ::  i, j, k, lsp
-      CHARACTER(len=16)    ::  spec_name
-
-
-      found = .FALSE.
-
-      spec_name = TRIM(variable(4:))
-!av == 0
+    SUBROUTINE chem_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
+
+
+       USE indices
+
+       USE kinds
+
+
+       IMPLICIT NONE
+
+       CHARACTER (LEN=*)    ::  variable     !<
+       INTEGER(iwp)         ::  av           !<
+       INTEGER(iwp) ::  nzb_do               !< lower limit of the data output (usually 0)
+       INTEGER(iwp) ::  nzt_do               !< vertical upper limit of the data output (usually nz_do3d)
+
+       LOGICAL      ::  found                !<
+
+       REAL(wp)             ::  fill_value !<
+       REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf 
+
+
+       !-- local variables
+
+       INTEGER              ::  i, j, k, lsp
+       CHARACTER(len=16)    ::  spec_name
+
+
+       found = .FALSE.
+
+       spec_name = TRIM(variable(4:))
 
        DO lsp=1,nspec
@@ -1229,10 +1121,10 @@
              ENDIF
 
-            found = .TRUE.
+             found = .TRUE.
           ENDIF
        ENDDO
 
        RETURN
-   END SUBROUTINE chem_data_output_3d
+    END SUBROUTINE chem_data_output_3d
 !
 !------------------------------------------------------------------------------!
@@ -1240,218 +1132,864 @@
 ! Description:
 ! ------------
-!> Subroutine for averaging 3D data of chemical species. Due to the fact that 
-!> the averaged chem arrays are allocated in chem_init, no if-query concerning
-!> the allocation is required (in any mode). Attention: If you just specify an 
-!> averaged output quantity in the _p3dr file during restarts the first output
-!> includes the time between the beginning of the restart run and the first
-!> output time (not necessarily the whole averaging_interval you have 
-!> specified in your _p3d/_p3dr file )
-!------------------------------------------------------------------------------!
-
-    SUBROUTINE chem_3d_data_averaging ( mode, variable )
-
-    USE control_parameters
-
-    USE indices
-
-    USE kinds
-
-    USE surface_mod,                                                         &
-        ONLY: surf_def_h, surf_lsm_h, surf_usm_h   
-  
-    IMPLICIT NONE
- 
-    CHARACTER (LEN=*) ::  mode    !< 
-    CHARACTER (LEN=*) :: variable !< 
- 
-    LOGICAL      ::  match_def !< flag indicating natural-type surface
-    LOGICAL      ::  match_lsm !< flag indicating natural-type surface
-    LOGICAL      ::  match_usm !< flag indicating urban-type surface
-
-    INTEGER(iwp) ::  i                  !< grid index x direction
-    INTEGER(iwp) ::  j                  !< grid index y direction
-    INTEGER(iwp) ::  k                  !< grid index z direction
-    INTEGER(iwp) ::  m                  !< running index surface type
-    INTEGER(iwp) :: lsp                 !< running index for chem spcs
-  
-    IF ( mode == 'allocate' )  THEN
-       DO lsp = 1, nspec
-          IF (TRIM(variable(4:)) == TRIM(chem_species(lsp)%name)) THEN
-             chem_species(lsp)%conc_av = 0.0_wp
+!> Subroutine defining mask output variables for chemical species
+!------------------------------------------------------------------------------!
+    
+    SUBROUTINE chem_data_output_mask( av, variable, found, local_pf )
+    
+       USE control_parameters
+       USE indices
+       USE kinds
+       USE pegrid,             ONLY: myid, threads_per_task
+
+
+       IMPLICIT NONE
+
+       CHARACTER (LEN=*)::  variable    !< 
+       INTEGER(iwp)     ::  av          !< flag to control data output of instantaneous or time-averaged data
+       LOGICAL          ::  found       !< 
+       REAL(wp), DIMENSION(mask_size_l(mid,1),mask_size_l(mid,2),mask_size_l(mid,3)) ::  &
+                 local_pf   !< 
+
+
+       !-- local variables.
+       CHARACTER(len=16)    ::  spec_name
+       INTEGER(iwp) ::  lsp
+       INTEGER(iwp) ::  i               !< grid index along x-direction
+       INTEGER(iwp) ::  j               !< grid index along y-direction
+       INTEGER(iwp) ::  k               !< grid index along z-direction
+       found = .TRUE.
+
+       spec_name = TRIM( variable(4:) )
+   !av == 0
+
+       DO lsp=1,nspec
+          IF (TRIM(spec_name) == TRIM(chem_species(lsp)%name) )               THEN             
+
+                IF(myid == 0 .AND. chem_debug0 )  WRITE(6,*) 'Output of species ' // TRIM(variable)  // &
+                                                          TRIM(chem_species(lsp)%name)       
+             IF (av == 0) THEN
+                DO  i = 1, mask_size_l(mid,1)
+                   DO  j = 1, mask_size_l(mid,2) 
+                      DO  k = 1, mask_size(mid,3) 
+                          local_pf(i,j,k) = chem_species(lsp)%conc(mask_k(mid,k),                                    &
+                                              mask_j(mid,j), mask_i(mid,i))
+                      ENDDO
+                   ENDDO
+                ENDDO
+           
+             ELSE
+                DO  i = 1, mask_size_l(mid,1)
+                   DO  j = 1, mask_size_l(mid,2)
+                      DO  k =  1, mask_size_l(mid,3)
+                          local_pf(i,j,k) = chem_species(lsp)%conc_av(mask_k(mid,k),                &
+                                             mask_j(mid,j), mask_i(mid,i))
+                      ENDDO
+                   ENDDO
+                ENDDO
+             ENDIF
+             found = .FALSE.
           ENDIF
        ENDDO
 
-    ELSEIF ( mode == 'sum' )  THEN
-   
+       RETURN
+     
+    END SUBROUTINE chem_data_output_mask      
+
+!
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine defining appropriate grid for netcdf variables.
+!> It is called out from subroutine netcdf.
+!------------------------------------------------------------------------------!
+    SUBROUTINE chem_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
+
+       IMPLICIT NONE
+
+       CHARACTER (LEN=*), INTENT(IN)  ::  var          !<
+       LOGICAL, INTENT(OUT)           ::  found        !<
+       CHARACTER (LEN=*), INTENT(OUT) ::  grid_x       !<
+       CHARACTER (LEN=*), INTENT(OUT) ::  grid_y       !<
+       CHARACTER (LEN=*), INTENT(OUT) ::  grid_z       !<
+
+       found  = .TRUE.
+
+       IF (var(1:3) == 'kc_')   THEN                   !< always the same grid for chemistry variables
+          grid_x = 'x'
+          grid_y = 'y'
+          grid_z = 'zu'                             
+       ELSE
+          found  = .FALSE.
+          grid_x = 'none'
+          grid_y = 'none'
+          grid_z = 'none'
+       ENDIF
+
+
+    END SUBROUTINE chem_define_netcdf_grid
+!
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine defining header output for chemistry model
+!------------------------------------------------------------------------------!
+    SUBROUTINE chem_header ( io )
+       
+       IMPLICIT NONE 
+ 
+       INTEGER(iwp), INTENT(IN) ::  io            !< Unit of the output file
+       INTEGER(iwp)             :: lsp            !< running index for chem spcs
+       INTEGER(iwp)             :: cs_fixed 
+       CHARACTER (LEN=80)       :: docsflux_chr
+       CHARACTER (LEN=80)       :: docsinit_chr
+
+!
+!--    Write chemistry model  header
+       WRITE( io, 1 )
+
+!--    Gasphase reaction status
+       IF ( chem_gasphase_on )  THEN 
+          WRITE( io, 2 )
+       ELSE
+          WRITE( io, 3 )
+       ENDIF
+
+!      Chemistry time-step
+       WRITE ( io, 4 ) cs_time_step
+
+!--    Emission mode info
+       IF ( mode_emis == "DEFAULT" )  THEN 
+          WRITE( io, 5 ) 
+       ELSEIF ( mode_emis == "PARAMETERIZED" )  THEN 
+          WRITE( io, 6 )
+       ELSEIF ( mode_emis == "PRE-PROCESSED" )  THEN 
+          WRITE( io, 7 )
+       ENDIF 
+
+!--    Photolysis scheme info
+       IF ( photolysis_scheme == "simple" )      THEN
+          WRITE( io, 8 ) 
+       ELSEIF (photolysis_scheme == "conastant" ) THEN
+          WRITE( io, 9 )
+       ENDIF
+ 
+ !--   Emission flux info
+       lsp = 1
+       docsflux_chr ='Chemical species for surface emission flux: ' 
+       DO WHILE ( surface_csflux_name(lsp) /= 'novalue' )
+          docsflux_chr = TRIM( docsflux_chr ) // ' ' // TRIM( surface_csflux_name(lsp) ) // ','  
+          IF ( LEN_TRIM( docsflux_chr ) >= 75 )  THEN
+           WRITE ( io, 10 )  docsflux_chr
+           docsflux_chr = '       '
+          ENDIF
+          lsp = lsp + 1
+       ENDDO
+ 
+       IF ( docsflux_chr /= '' )  THEN
+          WRITE ( io, 10 )  docsflux_chr
+       ENDIF
+
+
+!--    initializatoin of Surface and profile chemical species
+
+       lsp = 1
+       docsinit_chr ='Chemical species for initial surface and profile emissions: ' 
+       DO WHILE ( cs_name(lsp) /= 'novalue' )
+          docsinit_chr = TRIM( docsinit_chr ) // ' ' // TRIM( cs_name(lsp) ) // ','  
+          IF ( LEN_TRIM( docsinit_chr ) >= 75 )  THEN
+           WRITE ( io, 11 )  docsinit_chr
+           docsinit_chr = '       '
+          ENDIF
+          lsp = lsp + 1
+       ENDDO
+ 
+       IF ( docsinit_chr /= '' )  THEN
+          WRITE ( io, 11 )  docsinit_chr
+       ENDIF
+
+!--    number of variable and fix chemical species and number of reactions
+       cs_fixed = nspec - nvar
+       WRITE ( io, * ) '   --> Chemical species, variable: ', nvar
+       WRITE ( io, * ) '   --> Chemical species, fixed   : ', cs_fixed
+       WRITE ( io, * ) '   --> Total number of reactions : ', nreact
+
+
+1   FORMAT (//' Chemistry model information:'/                                  &
+              ' ----------------------------'/)
+2   FORMAT ('    --> Chemical reactions are turned on')
+3   FORMAT ('    --> Chemical reactions are turned off')
+4   FORMAT ('    --> Time-step for chemical species: ',F6.2, ' s')
+5   FORMAT ('    --> Emission mode = DEFAULT ')
+6   FORMAT ('    --> Emission mode = PARAMETERIZED ')
+7   FORMAT ('    --> Emission mode = PRE-PROCESSED ')
+8   FORMAT ('    --> Photolysis scheme used =  simple ')
+9   FORMAT ('    --> Photolysis scheme used =  constant ')
+10  FORMAT (/'    ',A)  
+11  FORMAT (/'    ',A) 
+!
+!
+    END SUBROUTINE chem_header
+
+!
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine initializating chemistry_model_mod
+!------------------------------------------------------------------------------!
+    SUBROUTINE chem_init
+
+       USE control_parameters,                                                  &
+          ONLY: message_string, io_blocks, io_group, turbulent_inflow
+       USE arrays_3d,                                                           &
+           ONLY: mean_inflow_profiles
+       USE pegrid
+
+       IMPLICIT   none
+   !-- local variables
+       INTEGER                 :: i,j               !< running index for for horiz numerical grid points
+       INTEGER                 :: lsp               !< running index for chem spcs
+       INTEGER                 :: lpr_lev           !< running index for chem spcs profile level
+!
+!-- NOPOINTER version not implemented yet
+! #if defined( __nopointer )
+!     message_string = 'The chemistry module only runs with POINTER version'
+!     CALL message( 'chemistry_model_mod', 'CM0001', 1, 2, 0, 6, 0 )      
+! #endif
+!
+!-- Allocate memory for chemical species
+       ALLOCATE( chem_species(nspec) )
+       ALLOCATE( spec_conc_1 (nzb:nzt+1,nysg:nyng,nxlg:nxrg,nspec) )
+       ALLOCATE( spec_conc_2 (nzb:nzt+1,nysg:nyng,nxlg:nxrg,nspec) )
+       ALLOCATE( spec_conc_3 (nzb:nzt+1,nysg:nyng,nxlg:nxrg,nspec) )
+       ALLOCATE( spec_conc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nspec) ) 
+       ALLOCATE( phot_frequen(nphot) ) 
+       ALLOCATE( freq_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nphot) )
+       ALLOCATE( bc_cs_t_val(nspec) )
+!
+!-- Initialize arrays
+       spec_conc_1 (:,:,:,:) = 0.0_wp
+       spec_conc_2 (:,:,:,:) = 0.0_wp
+       spec_conc_3 (:,:,:,:) = 0.0_wp
+       spec_conc_av(:,:,:,:) = 0.0_wp
+
+
        DO lsp = 1, nspec
-          IF (TRIM(variable(4:)) == TRIM(chem_species(lsp)%name)) THEN
-             DO  i = nxlg, nxrg
-                DO  j = nysg, nyng
-                   DO  k = nzb, nzt+1
-                       chem_species(lsp)%conc_av(k,j,i) = chem_species(lsp)%conc_av(k,j,i) + &
-                                                          chem_species(lsp)%conc(k,j,i)
+          chem_species(lsp)%name    = spc_names(lsp)
+
+          chem_species(lsp)%conc   (nzb:nzt+1,nysg:nyng,nxlg:nxrg)       => spec_conc_1 (:,:,:,lsp)
+          chem_species(lsp)%conc_p (nzb:nzt+1,nysg:nyng,nxlg:nxrg)       => spec_conc_2 (:,:,:,lsp)
+          chem_species(lsp)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg)       => spec_conc_3 (:,:,:,lsp)
+          chem_species(lsp)%conc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg)       => spec_conc_av(:,:,:,lsp)     
+
+          ALLOCATE (chem_species(lsp)%cssws_av(nysg:nyng,nxlg:nxrg))                   
+          chem_species(lsp)%cssws_av    = 0.0_wp
+!
+!--       The following block can be useful when emission module is not applied. &
+!--       if emission module is applied the following block will be overwritten.
+          ALLOCATE (chem_species(lsp)%flux_s_cs(nzb+1:nzt,0:threads_per_task-1))   
+          ALLOCATE (chem_species(lsp)%diss_s_cs(nzb+1:nzt,0:threads_per_task-1))   
+          ALLOCATE (chem_species(lsp)%flux_l_cs(nzb+1:nzt,nys:nyn,0:threads_per_task-1)) 
+          ALLOCATE (chem_species(lsp)%diss_l_cs(nzb+1:nzt,nys:nyn,0:threads_per_task-1))   
+          chem_species(lsp)%flux_s_cs = 0.0_wp                                     
+          chem_species(lsp)%flux_l_cs = 0.0_wp                                     
+          chem_species(lsp)%diss_s_cs = 0.0_wp                                      
+          chem_species(lsp)%diss_l_cs = 0.0_wp                                     
+!
+!--   Allocate memory for initial concentration profiles
+!--   (concentration values come from namelist)
+!--   (@todo (FK): Because of this, chem_init is called in palm before
+!--               check_parameters, since conc_pr_init is used there.
+!--               We have to find another solution since chem_init should
+!--               eventually be called from init_3d_model!!)
+          ALLOCATE ( chem_species(lsp)%conc_pr_init(0:nz+1) )
+          chem_species(lsp)%conc_pr_init(:) = 0.0_wp
+
+       ENDDO
+
+!
+!--    Initial concentration of profiles is prescribed by parameters cs_profile
+!--    and cs_heights in the namelist &chemistry_parameters
+       CALL chem_init_profiles      
+            
+            
+!
+!-- Initialize model variables
+
+
+       IF ( TRIM( initializing_actions ) /= 'read_restart_data'  .AND.            &
+            TRIM( initializing_actions ) /= 'cyclic_fill' )  THEN
+
+
+!--    First model run of a possible job queue.
+!--    Initial profiles of the variables must be computed.
+          IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
+            CALL location_message( 'initializing with 1D chemistry model profiles', .FALSE. )
+!
+!--        Transfer initial profiles to the arrays of the 3D model
+             DO lsp = 1, nspec
+                DO  i = nxlg, nxrg
+                   DO  j = nysg, nyng
+                      DO lpr_lev = 1, nz + 1
+                         chem_species(lsp)%conc(lpr_lev,j,i) = chem_species(lsp)%conc_pr_init(lpr_lev)
+                      ENDDO
+                   ENDDO
+                ENDDO   
+             ENDDO
+          
+          ELSEIF ( INDEX(initializing_actions, 'set_constant_profiles') /= 0 )    &
+          THEN
+             CALL location_message( 'initializing with constant chemistry profiles', .FALSE. )
+
+             DO lsp = 1, nspec 
+                DO  i = nxlg, nxrg
+                   DO  j = nysg, nyng
+                      chem_species(lsp)%conc(:,j,i) = chem_species(lsp)%conc_pr_init    
                    ENDDO
                 ENDDO
              ENDDO
-          ELSEIF ( TRIM(variable(4:)) == TRIM('cssws*') )        THEN
+
+          ENDIF
+
+!
+!--       If required, change the surface chem spcs at the start of the 3D run
+          IF ( cs_surface_initial_change(1) /= 0.0_wp ) THEN            
+             DO lsp = 1, nspec 
+                chem_species(lsp)%conc(nzb,:,:) = chem_species(lsp)%conc(nzb,:,:) +  &
+                                                  cs_surface_initial_change(lsp)
+             ENDDO
+          ENDIF 
+!
+!--      Initiale old and new time levels. 
+          DO lsp = 1, nvar
+             chem_species(lsp)%tconc_m = 0.0_wp                      
+             chem_species(lsp)%conc_p  = chem_species(lsp)%conc     
+          ENDDO
+
+       ENDIF
+
+
+
+!---   new code add above this line
+       DO lsp = 1, nphot
+          phot_frequen(lsp)%name = phot_names(lsp)
+!         IF( myid == 0 )  THEN
+!            WRITE(6,'(a,i4,3x,a)')  'Photolysis: ',lsp,trim(phot_names(lsp))
+!         ENDIF 
+             phot_frequen(lsp)%freq(nzb:nzt+1,nysg:nyng,nxlg:nxrg)    => freq_1(:,:,:,lsp)
+       ENDDO
+
+       RETURN
+
+ END SUBROUTINE chem_init
+
+!
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine defining initial vertical profiles of chemical species (given by
+!> namelist parameters chem_profiles and chem_heights)  --> which should work
+!> analogue to parameters u_profile, v_profile and uv_heights)
+!------------------------------------------------------------------------------!
+    SUBROUTINE chem_init_profiles              !< SUBROUTINE is called from chem_init in case of 
+                                               !< TRIM( initializing_actions ) /= 'read_restart_data'
+                                               !< We still need to see what has to be done in case of restart run
+       USE chem_modules
+
+       IMPLICIT NONE
+
+   !-- Local variables
+       INTEGER ::  lsp        !< running index for number of species in derived data type species_def
+       INTEGER ::  lsp_usr     !< running index for number of species (user defined)  in cs_names, cs_profiles etc
+       INTEGER ::  lpr_lev    !< running index for profile level for each chem spcs. 
+       INTEGER ::  npr_lev    !< the next available profile lev
+
+!-----------------
+!-- Parameter "cs_profile" and "cs_heights" are used to prescribe user defined initial profiles
+!-- and heights. If parameter "cs_profile" is not prescribed then initial surface values
+!-- "cs_surface" are used as constant initial profiles for each species. If "cs_profile" and
+!-- "cs_heights" are prescribed, their values will!override the constant profile given by
+!-- "cs_surface".
+! 
+       IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN 
+          lsp_usr = 1
+          DO  WHILE ( TRIM( cs_name( lsp_usr ) ) /= 'novalue' )   !'novalue' is the default
+             DO  lsp = 1, nspec                                !
+!--             create initial profile (conc_pr_init) for each chemical species
+                IF ( TRIM( chem_species(lsp)%name ) == TRIM( cs_name(lsp_usr) ) )  THEN   !
+                   IF ( cs_profile(lsp_usr,1) == 9999999.9_wp ) THEN
+!--                set a vertically constant profile based on the surface conc (cs_surface(lsp_usr)) of each species
+                      DO lpr_lev = 0, nzt+1
+                         chem_species(lsp)%conc_pr_init(lpr_lev) = cs_surface(lsp_usr)
+                      ENDDO
+                   ELSE
+                      IF ( cs_heights(1,1) /= 0.0_wp )  THEN
+                         message_string = 'The surface value of cs_heights must be 0.0'
+                         CALL message( 'chem_check_parameters', 'CM0434', 1, 2, 0, 6, 0 )
+                      ENDIF
+     
+                      use_prescribed_profile_data = .TRUE.
+    
+                      npr_lev = 1
+!                     chem_species(lsp)%conc_pr_init(0) = 0.0_wp
+                      DO  lpr_lev = 1, nz+1
+                         IF ( npr_lev < 100 )  THEN
+                            DO  WHILE ( cs_heights(lsp_usr, npr_lev+1) <= zu(lpr_lev) )
+                               npr_lev = npr_lev + 1
+                               IF ( npr_lev == 100 )  THEN
+                                   message_string = 'number of chem spcs exceeding the limit'
+                                   CALL message( 'chem_check_parameters', 'CM0435', 1, 2, 0, 6, 0 )               
+                                   EXIT
+                               ENDIF
+                            ENDDO
+                         ENDIF
+                         IF ( npr_lev < 100  .AND.  cs_heights(lsp_usr, npr_lev + 1) /= 9999999.9_wp )  THEN
+                            chem_species(lsp)%conc_pr_init(lpr_lev) = cs_profile(lsp_usr, npr_lev) +                          &
+                                                    ( zu(lpr_lev) - cs_heights(lsp_usr, npr_lev) ) /                          &
+                                                    ( cs_heights(lsp_usr, (npr_lev + 1)) - cs_heights(lsp_usr, npr_lev ) ) *  &
+                                                    ( cs_profile(lsp_usr, (npr_lev + 1)) - cs_profile(lsp_usr, npr_lev ) )
+                         ELSE
+                               chem_species(lsp)%conc_pr_init(lpr_lev) = cs_profile(lsp_usr, npr_lev)
+                         ENDIF
+                      ENDDO
+                   ENDIF
+!-- If a profile is prescribed explicity using cs_profiles and cs_heights, then  
+!-- chem_species(lsp)%conc_pr_init is populated with the specific "lsp" based
+!-- on the cs_profiles(lsp_usr,:)  and cs_heights(lsp_usr,:). 
+                ENDIF
+             ENDDO
+             lsp_usr = lsp_usr + 1
+          ENDDO
+       ENDIF
+
+    END SUBROUTINE chem_init_profiles
+!
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine to integrate chemical species in the given chemical mechanism
+!------------------------------------------------------------------------------!
+
+    SUBROUTINE chem_integrate_ij (i, j)
+
+       USE cpulog,                                                              &
+          ONLY: cpu_log, log_point
+       USE statistics,                                                          &
+          ONLY:  weight_pres
+        USE control_parameters,                                                 &
+          ONLY:  dt_3d, intermediate_timestep_count,simulated_time
+
+       IMPLICIT   none
+       INTEGER,INTENT(IN)       :: i,j
+
+ !--   local variables
+       INTEGER(iwp) ::  lsp                                                     !< running index for chem spcs.
+       INTEGER(iwp) ::  lph                                                     !< running index for photolysis frequencies
+       INTEGER                  :: k,m,istatf
+       INTEGER,DIMENSION(20)    :: istatus
+       REAL(kind=wp),DIMENSION(nzb+1:nzt,nspec)                :: tmp_conc
+       REAL(kind=wp),DIMENSION(nzb+1:nzt)                      :: tmp_temp
+       REAL(kind=wp),DIMENSION(nzb+1:nzt)                      :: tmp_qvap
+       REAL(kind=wp),DIMENSION(nzb+1:nzt,nphot)                :: tmp_phot
+       REAL(kind=wp),DIMENSION(nzb+1:nzt)                      :: tmp_fact
+       REAL(kind=wp),DIMENSION(nzb+1:nzt)                      :: tmp_fact_i    !< conversion factor between 
+                                                                                !<    molecules cm^{-3} and ppm
+
+       INTEGER,DIMENSION(nzb+1:nzt)                            :: nacc          !< Number of accepted steps
+       INTEGER,DIMENSION(nzb+1:nzt)                            :: nrej          !< Number of rejected steps
+
+       REAL(wp)                         ::  conv                                !< conversion factor
+       REAL(wp), PARAMETER              ::  ppm2fr  = 1.0e-6_wp                 !< Conversion factor ppm to fraction
+       REAL(wp), PARAMETER              ::  xm_air  = 28.96_wp                  !< Mole mass of dry air
+       REAL(wp), PARAMETER              ::  xm_h2o  = 18.01528_wp               !< Mole mass of water vapor
+       REAL(wp), PARAMETER              ::  pref_i  = 1._wp / 100000.0_wp       !< inverse reference pressure (1/Pa)
+       REAL(wp), PARAMETER              ::  t_std   = 273.15_wp                 !< standard pressure (Pa)
+       REAL(wp), PARAMETER              ::  p_std   = 101325.0_wp               !< standard pressure (Pa)
+       REAL(wp), PARAMETER              ::  vmolcm  = 22.414e3_wp               !< Mole volume (22.414 l) in cm^{-3}
+       REAL(wp), PARAMETER              ::  xna     = 6.022e23_wp               !< Avogadro number (molecules/mol)
+
+       REAL(wp),DIMENSION(size(rcntrl)) :: rcntrl_local
+
+
+       REAL(kind=wp)  :: dt_chem                                             
+
+       CALL cpu_log( log_point(80), '[chem_integrate_ij]', 'start' )
+!<     set chem_gasphase_on to .FALSE. if you want to skip computation of gas phase chemistry
+       IF (chem_gasphase_on) THEN
+          nacc = 0
+          nrej = 0
+
+       tmp_temp(:) = pt(nzb+1:nzt,j,i) * exner(nzb+1:nzt)
+!         ppm to molecules/cm**3
+!         tmp_fact = 1.e-6_wp*6.022e23_wp/(22.414_wp*1000._wp) * 273.15_wp * hyp(nzb+1:nzt)/( 101300.0_wp * tmp_temp )  
+          conv = ppm2fr * xna / vmolcm
+          tmp_fact(:) = conv * t_std * hyp(nzb+1:nzt) / (tmp_temp(:) * p_std)
+          tmp_fact_i = 1.0_wp/tmp_fact
+
+          IF ( humidity ) THEN
+             IF ( bulk_cloud_model )  THEN
+                tmp_qvap(:) = ( q(nzb+1:nzt,j,i) - ql(nzb+1:nzt,j,i) ) * xm_air/xm_h2o * tmp_fact(:)
+             ELSE
+                tmp_qvap(:) = q(nzb+1:nzt,j,i) * xm_air/xm_h2o * tmp_fact(:)
+             ENDIF
+          ELSE
+             tmp_qvap(:) = 0.01 * tmp_fact(:)                          !< Constant value for q if water vapor is not computed
+          ENDIF
+
+          DO lsp = 1,nspec
+             tmp_conc(:,lsp) = chem_species(lsp)%conc(nzb+1:nzt,j,i) * tmp_fact(:) 
+          ENDDO
+
+          DO lph = 1,nphot
+             tmp_phot(:,lph) = phot_frequen(lph)%freq(nzb+1:nzt,j,i)               
+          ENDDO
+
+          IF(myid == 0 .AND. chem_debug0 ) THEN
+             IF (i == 10 .and. j == 10) WRITE(0,*) 'begin chemics step ',dt_3d
+          ENDIF
+
+!--       Compute length of time step
+          IF ( call_chem_at_all_substeps )  THEN
+             dt_chem = dt_3d * weight_pres(intermediate_timestep_count)
+          ELSE
+             dt_chem = dt_3d
+          ENDIF
+
+          cs_time_step = dt_chem
+
+          CALL cpu_log( log_point(81), '{chem_gasphase_integrate}', 'start' )
+
+          IF(maxval(rcntrl) > 0.0)   THEN    ! Only if rcntrl is set
+             IF( simulated_time <= 2*dt_3d)  THEN
+                 rcntrl_local = 0
+                 WRITE(9,'(a,2f10.3)') 'USE Default rcntrl in the first steps ',simulated_time,dt_3d
+             ELSE
+                 rcntrl_local = rcntrl
+             ENDIF
+          ELSE
+             rcntrl_local = 0
+          END IF
+
+          CALL chem_gasphase_integrate (dt_chem, tmp_conc, tmp_temp, tmp_qvap, tmp_fact, tmp_phot, &
+                             icntrl_i = icntrl, rcntrl_i = rcntrl_local, xnacc = nacc, xnrej = nrej, istatus=istatus)
+
+          CALL cpu_log( log_point(81), '{chem_gasphase_integrate}', 'stop' )
+
+          DO lsp = 1,nspec
+             chem_species(lsp)%conc (nzb+1:nzt,j,i) = tmp_conc(:,lsp) * tmp_fact_i(:)
+          ENDDO
+
+
+       ENDIF
+          CALL cpu_log( log_point(80), '[chem_integrate_ij]', 'stop' )
+
+       RETURN
+    END SUBROUTINE chem_integrate_ij
+!
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine defining parin for &chemistry_parameters for chemistry model
+!------------------------------------------------------------------------------!
+    SUBROUTINE chem_parin
+   
+       USE chem_modules
+       USE control_parameters
+      
+       USE kinds
+       USE pegrid
+       USE statistics
+           
+       IMPLICIT   NONE
+
+       CHARACTER (LEN=80) ::  line                        !< dummy string that contains the current line of the parameter file
+       CHARACTER (LEN=3)  ::  cs_prefix 
+
+       REAL(wp), DIMENSION(nmaxfixsteps) ::   my_steps    !< List of fixed timesteps   my_step(1) = 0.0 automatic stepping
+       INTEGER(iwp) ::  i                                 !< 
+       INTEGER(iwp) ::  j                                 !< 
+       INTEGER(iwp) ::  max_pr_cs_tmp                     !< 
+
+
+       NAMELIST /chemistry_parameters/  bc_cs_b,                          &
+                                        bc_cs_t,                          &
+                                        call_chem_at_all_substeps,        &
+                                        chem_debug0,                      &
+                                        chem_debug1,                      &
+                                        chem_debug2,                      &
+                                        chem_gasphase_on,                 &
+                                        cs_heights,                       &
+                                        cs_name,                          &
+                                        cs_profile,                       &
+                                        cs_profile_name,                  & 
+                                        cs_surface,                       &
+                                        decycle_chem_lr,                  &
+                                        decycle_chem_ns,                  &            
+                                        decycle_method,                   & 
+                                        emiss_factor_main,                &
+                                        emiss_factor_side,                &                      
+                                        icntrl,                           &
+                                        main_street_id,                   &
+                                        max_street_id,                    &
+                                        my_steps,                         &
+                                        nest_chemistry,                   &
+                                        rcntrl,                           &
+                                        side_street_id,                   &
+                                        photolysis_scheme,                &
+                                        wall_csflux,                      &
+                                        cs_vertical_gradient,             &
+                                        top_csflux,                       & 
+                                        surface_csflux,                   &
+                                        surface_csflux_name,              &
+                                        cs_surface_initial_change,        &
+                                        cs_vertical_gradient_level,       &
+!                                       namelist parameters for emissions
+                                        mode_emis,                        &
+                                        time_fac_type,                    &
+                                        daytype_mdh,                      &
+                                        do_emis                              
+                             
+!-- analogue to chem_names(nspj) we could invent chem_surfaceflux(nspj) and chem_topflux(nspj)
+!-- so this way we could prescribe a specific flux value for each species
+!>  chemistry_parameters for initial profiles
+!>  cs_names = 'O3', 'NO2', 'NO', ...   to set initial profiles)
+!>  cs_heights(1,:) = 0.0, 100.0, 500.0, 2000.0, .... (height levels where concs will be prescribed for O3)
+!>  cs_heights(2,:) = 0.0, 200.0, 400.0, 1000.0, .... (same for NO2 etc.) 
+!>  cs_profiles(1,:) = 10.0, 20.0, 20.0, 30.0, .....  (chem spcs conc at height lvls chem_heights(1,:)) etc.
+!>  If the respective concentration profile should be constant with height, then use "cs_surface( number of spcs)"
+!>  then write these cs_surface values to chem_species(lsp)%conc_pr_init(:)
+
+!
+!--   Read chem namelist   
+
+       INTEGER             :: ier
+       CHARACTER(LEN=64)   :: text
+       CHARACTER(LEN=8)    :: solver_type
+
+       icntrl    = 0
+       rcntrl    = 0.0_wp
+       my_steps  = 0.0_wp
+       photolysis_scheme = 'simple'
+       atol = 1.0_wp
+       rtol = 0.01_wp
+ !
+ !--   Try to find chemistry package
+       REWIND ( 11 )
+       line = ' '
+       DO   WHILE ( INDEX( line, '&chemistry_parameters' ) == 0 )
+          READ ( 11, '(A)', END=20 )  line
+       ENDDO
+       BACKSPACE ( 11 )
+ !
+ !--   Read chemistry namelist
+       READ ( 11, chemistry_parameters, ERR = 10, END = 20 )      
+ !
+ !--   Enable chemistry model
+       air_chemistry = .TRUE.                    
+      GOTO 20
+
+ 10   BACKSPACE( 11 )
+      READ( 11 , '(A)') line
+      CALL parin_fail_message( 'chemistry_parameters', line )
+
+ 20   CONTINUE
+
+!
+!--    check for  emission mode for chem species
+       IF ( (mode_emis /= 'PARAMETERIZED')  .AND. ( mode_emis /= 'DEFAULT') .AND. (mode_emis /= 'PRE-PROCESSED'  ) )   THEN
+            message_string = 'Incorrect mode_emiss  option select. Please check spelling'
+            CALL message( 'chem_check_parameters', 'CM0436', 1, 2, 0, 6, 0 )
+       ENDIF
+
+       t_steps = my_steps          
+                                   
+!--    Determine the number of user-defined profiles and append them to the
+!--    standard data output (data_output_pr)
+       max_pr_cs_tmp = 0 
+       i = 1
+
+       DO  WHILE ( data_output_pr(i)  /= ' '  .AND.  i <= 100 )
+          IF ( TRIM( data_output_pr(i)(1:3)) == 'kc_' ) THEN
+             max_pr_cs_tmp = max_pr_cs_tmp+1
+          ENDIF
+          i = i +1
+       ENDDO
+
+       IF ( max_pr_cs_tmp > 0 ) THEN
+          cs_pr_namelist_found = .TRUE.
+          max_pr_cs = max_pr_cs_tmp
+       ENDIF
+
+!      Set Solver Type
+       IF(icntrl(3) == 0)   THEN
+          solver_type = 'rodas3'           !Default
+       ELSE IF(icntrl(3) == 1)   THEN
+          solver_type = 'ros2'
+       ELSE IF(icntrl(3) == 2)   THEN
+          solver_type = 'ros3'
+       ELSE IF(icntrl(3) == 3)   THEN
+          solver_type = 'ro4'
+       ELSE IF(icntrl(3) == 4)   THEN
+          solver_type = 'rodas3'
+       ELSE IF(icntrl(3) == 5)   THEN
+          solver_type = 'rodas4'
+       ELSE IF(icntrl(3) == 6)   THEN
+          solver_type = 'Rang3'
+       ELSE
+          IF(myid == 0)  write(0,*) 'illegal solver type '     !kk chane to PALM error message
+          call MPI_Abort (MPI_COMM_WORLD, 1, ier)
+       END IF
+
+       write(text,*) 'gas_phase chemistry: solver_type = ',trim(solver_type)
+!kk    Has to be changed to right calling sequence
+!kk       CALL location_message( trim(text), .FALSE. )
+       IF(myid == 0)   THEN
+          write(9,*) ' '
+          write(9,*) 'kpp setup '
+          write(9,*) ' '
+          write(9,*) '    gas_phase chemistry: solver_type = ',trim(solver_type)
+          write(9,*) ' '
+          write(9,*) '    Hstart  = ',rcntrl(3)
+          write(9,*) '    FacMin  = ',rcntrl(4)
+          write(9,*) '    FacMax  = ',rcntrl(5)
+          write(9,*) ' '
+          IF(vl_dim > 1)    THEN
+             write(9,*) '    Vector mode                   vektor length = ',vl_dim
+          ELSE
+             write(9,*) '    Scalar mode'
+          ENDIF
+          write(9,*) ' '
+       END IF
+
+       RETURN
+
+    END SUBROUTINE chem_parin
+
+!
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine calculating prognostic equations for chemical species 
+!> (vector-optimized).
+!> Routine is called separately for each chemical species over a loop from
+!> prognostic_equations.
+!------------------------------------------------------------------------------!
+    SUBROUTINE chem_prognostic_equations ( cs_scalar_p, cs_scalar, tcs_scalar_m,  &
+                                           pr_init_cs, ilsp )
+
+       USE advec_s_pw_mod,                                                        &
+           ONLY:  advec_s_pw
+       USE advec_s_up_mod,                                                        &
+           ONLY:  advec_s_up
+       USE advec_ws,                                                              &
+           ONLY:  advec_s_ws 
+       USE diffusion_s_mod,                                                       &
+           ONLY:  diffusion_s
+       USE indices,                                                               &
+           ONLY:  nxl, nxr, nyn, nys, wall_flags_0
+       USE pegrid
+       USE surface_mod,                                                           &
+           ONLY:  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h,     &
+                  surf_usm_v
+
+       IMPLICIT NONE
+
+       INTEGER ::  i   !< running index
+       INTEGER ::  j   !< running index
+       INTEGER ::  k   !< running index
+
+       INTEGER(iwp),INTENT(IN) ::  ilsp          !<
+
+       REAL(wp), DIMENSION(0:nz+1) ::  pr_init_cs   !<
+
+       REAL(wp), DIMENSION(:,:,:), POINTER ::  cs_scalar      !<
+       REAL(wp), DIMENSION(:,:,:), POINTER ::  cs_scalar_p    !<
+       REAL(wp), DIMENSION(:,:,:), POINTER ::  tcs_scalar_m   !<
+
+
+   !
+   !-- Tendency terms for chemical species
+       tend = 0.0_wp
+   !    
+   !-- Advection terms
+       IF ( timestep_scheme(1:5) == 'runge' )  THEN
+          IF ( ws_scheme_sca )  THEN
+             CALL advec_s_ws( cs_scalar, 'kc' )
+          ELSE
+             CALL advec_s_pw( cs_scalar )
+          ENDIF
+       ELSE
+            CALL advec_s_up( cs_scalar )
+       ENDIF
+   !
+   !-- Diffusion terms  (the last three arguments are zero)
+       CALL diffusion_s( cs_scalar,                                               &
+                         surf_def_h(0)%cssws(ilsp,:),                             &
+                         surf_def_h(1)%cssws(ilsp,:),                             &
+                         surf_def_h(2)%cssws(ilsp,:),                             &
+                         surf_lsm_h%cssws(ilsp,:),                                &
+                         surf_usm_h%cssws(ilsp,:),                                &
+                         surf_def_v(0)%cssws(ilsp,:),                             &
+                         surf_def_v(1)%cssws(ilsp,:),                             &
+                         surf_def_v(2)%cssws(ilsp,:),                             &
+                         surf_def_v(3)%cssws(ilsp,:),                             &
+                         surf_lsm_v(0)%cssws(ilsp,:),                             &
+                         surf_lsm_v(1)%cssws(ilsp,:),                             &
+                         surf_lsm_v(2)%cssws(ilsp,:),                             &
+                         surf_lsm_v(3)%cssws(ilsp,:),                             &
+                         surf_usm_v(0)%cssws(ilsp,:),                             &
+                         surf_usm_v(1)%cssws(ilsp,:),                             &
+                         surf_usm_v(2)%cssws(ilsp,:),                             &
+                         surf_usm_v(3)%cssws(ilsp,:) )
+   !    
+   !-- Prognostic equation for chemical species
+       DO  i = nxl, nxr
+          DO  j = nys, nyn    
+             DO  k = nzb+1, nzt
+                cs_scalar_p(k,j,i) =   cs_scalar(k,j,i)                           &
+                                     + ( dt_3d  *                                 &
+                                         (   tsc(2) * tend(k,j,i)                 &
+                                           + tsc(3) * tcs_scalar_m(k,j,i)         &
+                                         )                                        & 
+                                       - tsc(5) * rdf_sc(k)                       &
+                                                * ( cs_scalar(k,j,i) - pr_init_cs(k) )    &   
+                                       )                                          &
+                                       * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )       
+
+                IF ( cs_scalar_p(k,j,i) < 0.0_wp )  cs_scalar_p(k,j,i) = 0.1_wp * cs_scalar(k,j,i)
+             ENDDO
+          ENDDO
+       ENDDO
+   !
+   !-- Calculate tendencies for the next Runge-Kutta step
+       IF ( timestep_scheme(1:5) == 'runge' )  THEN
+          IF ( intermediate_timestep_count == 1 )  THEN
+             DO  i = nxl, nxr
+                DO  j = nys, nyn   
+                   DO  k = nzb+1, nzt
+                      tcs_scalar_m(k,j,i) = tend(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ELSEIF ( intermediate_timestep_count < &
+             intermediate_timestep_count_max )  THEN
              DO  i = nxl, nxr
                 DO  j = nys, nyn
-                   match_def = surf_def_h(0)%start_index(j,i) <=               &
-                               surf_def_h(0)%end_index(j,i)
-                   match_lsm = surf_lsm_h%start_index(j,i) <=                  &
-                               surf_lsm_h%end_index(j,i)
-                   match_usm = surf_usm_h%start_index(j,i) <=                  &
-                               surf_usm_h%end_index(j,i)
-
-                   IF ( match_def )  THEN
-                      m = surf_def_h(0)%end_index(j,i)
-                      chem_species(lsp)%cssws_av(j,i) =                        &
-                                             chem_species(lsp)%cssws_av(j,i) + &
-                                             surf_def_h(0)%cssws(lsp,m)
-                   ELSEIF ( match_lsm  .AND.  .NOT. match_usm )  THEN
-                      m = surf_lsm_h%end_index(j,i)
-                      chem_species(lsp)%cssws_av(j,i) =                        &
-                                             chem_species(lsp)%cssws_av(j,i) + &
-                                             surf_lsm_h%cssws(lsp,m)
-                   ELSEIF ( match_usm )  THEN
-                      m = surf_usm_h%end_index(j,i)
-                      chem_species(lsp)%cssws_av(j,i) =                        &
-                                             chem_species(lsp)%cssws_av(j,i) + &
-                                             surf_usm_h%cssws(lsp,m)
-                   ENDIF
+                   DO  k = nzb+1, nzt
+                      tcs_scalar_m(k,j,i) = - 9.5625_wp * tend(k,j,i)             &
+                                            + 5.3125_wp * tcs_scalar_m(k,j,i)
+                   ENDDO
                 ENDDO
              ENDDO
           ENDIF
-       ENDDO
- 
-    ELSEIF ( mode == 'average' )  THEN
-       DO lsp = 1, nspec
-          IF (TRIM(variable(4:)) == TRIM(chem_species(lsp)%name)) THEN
-             DO  i = nxlg, nxrg
-                DO  j = nysg, nyng
-                   DO  k = nzb, nzt+1
-                       chem_species(lsp)%conc_av(k,j,i) = chem_species(lsp)%conc_av(k,j,i) / REAL( average_count_3d, KIND=wp )
-                   ENDDO
-                ENDDO
-             ENDDO
-
-          ELSEIF (TRIM(variable(4:)) == TRIM('cssws*') )            THEN
-             DO i = nxlg, nxrg
-                DO  j = nysg, nyng
-                     chem_species(lsp)%cssws_av(j,i) = chem_species(lsp)%cssws_av(j,i) / REAL( average_count_3d, KIND=wp )
-                ENDDO
-             ENDDO
-                CALL exchange_horiz_2d( chem_species(lsp)%cssws_av, nbgp )                 
-          ENDIF
-       ENDDO
-       
-    ENDIF     
-
-    END SUBROUTINE chem_3d_data_averaging
-
-!------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine to write restart data for chemistry model
-!------------------------------------------------------------------------------!
- SUBROUTINE chem_wrd_local
-
-
-    IMPLICIT NONE 
-
-    INTEGER(iwp) ::  lsp !< 
-
-!      REAL(kind=wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   :: chems_conc
-
-
-    DO  lsp = 1, nspec
-
-       CALL wrd_write_string( TRIM( chem_species(lsp)%name ))
-       WRITE ( 14 )  chem_species(lsp)%conc
-
-       CALL wrd_write_string( TRIM( chem_species(lsp)%name )//'_av' )
-       WRITE ( 14 )  chem_species(lsp)%conc_av
-
-    ENDDO
-
-
- END SUBROUTINE chem_wrd_local
-
-!------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine to read restart data of chemical species
-!------------------------------------------------------------------------------!
-
- SUBROUTINE chem_rrd_local( i, k, nxlf, nxlc, nxl_on_file, nxrf, nxrc,         &
-                            nxr_on_file, nynf, nync, nyn_on_file, nysf, nysc,  &
-                            nys_on_file, tmp_3d, found )    
-                                     
-    USE control_parameters
-            
-    USE indices
-    
-    USE pegrid
-
-    IMPLICIT NONE 
-
-    CHARACTER (LEN=20) :: spc_name_av !<   
-       
-    INTEGER(iwp) ::  i, lsp          !< 
-    INTEGER(iwp) ::  k               !< 
-    INTEGER(iwp) ::  nxlc            !< 
-    INTEGER(iwp) ::  nxlf            !< 
-    INTEGER(iwp) ::  nxl_on_file     !<   
-    INTEGER(iwp) ::  nxrc            !< 
-    INTEGER(iwp) ::  nxrf            !< 
-    INTEGER(iwp) ::  nxr_on_file     !<   
-    INTEGER(iwp) ::  nync            !< 
-    INTEGER(iwp) ::  nynf            !< 
-    INTEGER(iwp) ::  nyn_on_file     !<   
-    INTEGER(iwp) ::  nysc            !< 
-    INTEGER(iwp) ::  nysf            !< 
-    INTEGER(iwp) ::  nys_on_file     !<   
-    
-    LOGICAL, INTENT(OUT)  :: found 
-
-    REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d   !< 3D array to temp store data
-
-
-    found = .FALSE.  
-
-
-       IF ( ALLOCATED(chem_species) )  THEN
-
-          DO  lsp = 1, nspec
-
-              !< for time-averaged chemical conc.
-             spc_name_av  =  TRIM(chem_species(lsp)%name)//'_av'
-
-             IF (restart_string(1:length) == TRIM(chem_species(lsp)%name) )    &
-             THEN
-                !< read data into tmp_3d
-                IF ( k == 1 )  READ ( 13 )  tmp_3d  
-                !< fill ..%conc in the restart run    
-                chem_species(lsp)%conc(:,nysc-nbgp:nync+nbgp,                  &
-                                       nxlc-nbgp:nxrc+nbgp) =                  & 
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-                found = .TRUE.
-             ELSEIF (restart_string(1:length) == spc_name_av )  THEN
-                IF ( k == 1 )  READ ( 13 )  tmp_3d
-                chem_species(lsp)%conc_av(:,nysc-nbgp:nync+nbgp,               &
-                                          nxlc-nbgp:nxrc+nbgp) =               &
-                tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-                found = .TRUE.
-             ENDIF
-
-          ENDDO
-
        ENDIF
 
-
- END SUBROUTINE chem_rrd_local
-
+    END SUBROUTINE chem_prognostic_equations
 
 !------------------------------------------------------------------------------!
@@ -1464,46 +2002,46 @@
 !> prognostic_equations.
 !------------------------------------------------------------------------------!
- SUBROUTINE chem_prognostic_equations_ij ( cs_scalar_p, cs_scalar, tcs_scalar_m, pr_init_cs,  &
-                            i, j, i_omp_start, tn, ilsp, flux_s_cs, diss_s_cs, &
-                            flux_l_cs, diss_l_cs )
-    USE pegrid         
-    USE advec_ws,        ONLY:  advec_s_ws 
-    USE advec_s_pw_mod,  ONLY:  advec_s_pw
-    USE advec_s_up_mod,  ONLY:  advec_s_up
-    USE diffusion_s_mod, ONLY:  diffusion_s
-    USE indices,         ONLY:  wall_flags_0
-    USE surface_mod,     ONLY:  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h,    &
-                                surf_usm_v
-
-
-    IMPLICIT NONE
-
-    REAL(wp), DIMENSION(:,:,:), POINTER   :: cs_scalar_p, cs_scalar, tcs_scalar_m
-
-    INTEGER(iwp),INTENT(IN) :: i, j, i_omp_start, tn, ilsp
-    REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1)         :: flux_s_cs   !<
-    REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1)         :: diss_s_cs   !<
-    REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: flux_l_cs   !<
-    REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: diss_l_cs   !<
-    REAL(wp), DIMENSION(0:nz+1)                                 :: pr_init_cs  !<
+    SUBROUTINE chem_prognostic_equations_ij ( cs_scalar_p, cs_scalar, tcs_scalar_m, pr_init_cs,    &
+                               i, j, i_omp_start, tn, ilsp, flux_s_cs, diss_s_cs,                  &
+                               flux_l_cs, diss_l_cs )
+       USE pegrid         
+       USE advec_ws,        ONLY:  advec_s_ws 
+       USE advec_s_pw_mod,  ONLY:  advec_s_pw
+       USE advec_s_up_mod,  ONLY:  advec_s_up
+       USE diffusion_s_mod, ONLY:  diffusion_s
+       USE indices,         ONLY:  wall_flags_0
+       USE surface_mod,     ONLY:  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h,     &
+                                   surf_usm_v
+
+
+       IMPLICIT NONE
+
+       REAL(wp), DIMENSION(:,:,:), POINTER   :: cs_scalar_p, cs_scalar, tcs_scalar_m
+
+       INTEGER(iwp),INTENT(IN) :: i, j, i_omp_start, tn, ilsp
+       REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1)         :: flux_s_cs   !<
+       REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1)         :: diss_s_cs   !<
+       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: flux_l_cs   !<
+       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: diss_l_cs   !<
+       REAL(wp), DIMENSION(0:nz+1)                                 :: pr_init_cs  !<
 
 !-- local variables
 
-    INTEGER :: k
-    !
-    !--    Tendency-terms for chem spcs.
-    tend(:,j,i) = 0.0_wp
+       INTEGER :: k
+!
+!--    Tendency-terms for chem spcs.
+       tend(:,j,i) = 0.0_wp
 !    
 !-- Advection terms
-    IF ( timestep_scheme(1:5) == 'runge' )  THEN
-       IF ( ws_scheme_sca )  THEN
-          CALL advec_s_ws( i, j, cs_scalar, 'kc', flux_s_cs, diss_s_cs,                &
-             flux_l_cs, diss_l_cs, i_omp_start, tn )
+       IF ( timestep_scheme(1:5) == 'runge' )  THEN
+          IF ( ws_scheme_sca )  THEN
+             CALL advec_s_ws( i, j, cs_scalar, 'kc', flux_s_cs, diss_s_cs,                &
+                flux_l_cs, diss_l_cs, i_omp_start, tn )
+          ELSE
+             CALL advec_s_pw( i, j, cs_scalar )
+          ENDIF
        ELSE
-          CALL advec_s_pw( i, j, cs_scalar )
+            CALL advec_s_up( i, j, cs_scalar )
        ENDIF
-    ELSE
-         CALL advec_s_up( i, j, cs_scalar )
-    ENDIF
 
 !
@@ -1511,369 +2049,242 @@
 !-- Diffusion terms (the last three arguments are zero)
 
-      CALL diffusion_s( i, j, cs_scalar,                                                 &
-                        surf_def_h(0)%cssws(ilsp,:), surf_def_h(1)%cssws(ilsp,:),        &
-                        surf_def_h(2)%cssws(ilsp,:),                                     &
-                        surf_lsm_h%cssws(ilsp,:), surf_usm_h%cssws(ilsp,:),              &
-                        surf_def_v(0)%cssws(ilsp,:), surf_def_v(1)%cssws(ilsp,:),        &
-                        surf_def_v(2)%cssws(ilsp,:), surf_def_v(3)%cssws(ilsp,:),        &
-                        surf_lsm_v(0)%cssws(ilsp,:), surf_lsm_v(1)%cssws(ilsp,:),        &
-                        surf_lsm_v(2)%cssws(ilsp,:), surf_lsm_v(3)%cssws(ilsp,:),        &
-                        surf_usm_v(0)%cssws(ilsp,:), surf_usm_v(1)%cssws(ilsp,:),        &
-                        surf_usm_v(2)%cssws(ilsp,:), surf_usm_v(3)%cssws(ilsp,:) )
- 
+         CALL diffusion_s( i, j, cs_scalar,                                                 &
+                           surf_def_h(0)%cssws(ilsp,:), surf_def_h(1)%cssws(ilsp,:),        &
+                           surf_def_h(2)%cssws(ilsp,:),                                     &
+                           surf_lsm_h%cssws(ilsp,:), surf_usm_h%cssws(ilsp,:),              &
+                           surf_def_v(0)%cssws(ilsp,:), surf_def_v(1)%cssws(ilsp,:),        &
+                           surf_def_v(2)%cssws(ilsp,:), surf_def_v(3)%cssws(ilsp,:),        &
+                           surf_lsm_v(0)%cssws(ilsp,:), surf_lsm_v(1)%cssws(ilsp,:),        &
+                           surf_lsm_v(2)%cssws(ilsp,:), surf_lsm_v(3)%cssws(ilsp,:),        &
+                           surf_usm_v(0)%cssws(ilsp,:), surf_usm_v(1)%cssws(ilsp,:),        &
+                           surf_usm_v(2)%cssws(ilsp,:), surf_usm_v(3)%cssws(ilsp,:) )
+    
 !    
 !-- Prognostic equation for chem spcs
-    DO k = nzb+1, nzt
-       cs_scalar_p(k,j,i) = cs_scalar(k,j,i) + ( dt_3d  *                       &
-                                               ( tsc(2) * tend(k,j,i) +         &
-                                                 tsc(3) * tcs_scalar_m(k,j,i) ) & 
-                                               - tsc(5) * rdf_sc(k)             &
-                                                        * ( cs_scalar(k,j,i) - pr_init_cs(k) )    &   
-                                               )                                                  &
-                                                        * MERGE( 1.0_wp, 0.0_wp,                  &      
-                                                                BTEST( wall_flags_0(k,j,i), 0 )   &             
-                                                                 )       
-
-       IF ( cs_scalar_p(k,j,i) < 0.0_wp )  cs_scalar_p(k,j,i) = 0.1_wp * cs_scalar(k,j,i)    !FKS6
-    ENDDO
+       DO k = nzb+1, nzt
+          cs_scalar_p(k,j,i) = cs_scalar(k,j,i) + ( dt_3d  *                       &
+                                                  ( tsc(2) * tend(k,j,i) +         &
+                                                    tsc(3) * tcs_scalar_m(k,j,i) ) & 
+                                                  - tsc(5) * rdf_sc(k)             &
+                                                           * ( cs_scalar(k,j,i) - pr_init_cs(k) )    &   
+                                                  )                                                  &
+                                                           * MERGE( 1.0_wp, 0.0_wp,                  &      
+                                                                   BTEST( wall_flags_0(k,j,i), 0 )   &             
+                                                                    )       
+
+          IF ( cs_scalar_p(k,j,i) < 0.0_wp )  cs_scalar_p(k,j,i) = 0.1_wp * cs_scalar(k,j,i)    !FKS6
+       ENDDO
 
 !
 !-- Calculate tendencies for the next Runge-Kutta step
-    IF ( timestep_scheme(1:5) == 'runge' )  THEN
-       IF ( intermediate_timestep_count == 1 )  THEN
-          DO  k = nzb+1, nzt
-             tcs_scalar_m(k,j,i) = tend(k,j,i)
-          ENDDO
-       ELSEIF ( intermediate_timestep_count < &
-          intermediate_timestep_count_max )  THEN
-          DO  k = nzb+1, nzt
-             tcs_scalar_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
-                5.3125_wp * tcs_scalar_m(k,j,i)
-          ENDDO
+       IF ( timestep_scheme(1:5) == 'runge' )  THEN
+          IF ( intermediate_timestep_count == 1 )  THEN
+             DO  k = nzb+1, nzt
+                tcs_scalar_m(k,j,i) = tend(k,j,i)
+             ENDDO
+          ELSEIF ( intermediate_timestep_count < &
+             intermediate_timestep_count_max )  THEN
+             DO  k = nzb+1, nzt
+                tcs_scalar_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
+                   5.3125_wp * tcs_scalar_m(k,j,i)
+             ENDDO
+          ENDIF
        ENDIF
-    ENDIF
-
- END SUBROUTINE chem_prognostic_equations_ij
-
-
+
+    END SUBROUTINE chem_prognostic_equations_ij
+
+!
 !------------------------------------------------------------------------------!
 !
 ! Description:
 ! ------------
-!> Subroutine calculating prognostic equations for chemical species 
-!> (vector-optimized).
-!> Routine is called separately for each chemical species over a loop from
-!> prognostic_equations.
-!------------------------------------------------------------------------------!
- SUBROUTINE chem_prognostic_equations ( cs_scalar_p, cs_scalar, tcs_scalar_m,  &
-                                        pr_init_cs, ilsp )
-
-    USE advec_s_pw_mod,                                                        &
-        ONLY:  advec_s_pw
-
-    USE advec_s_up_mod,                                                        &
-        ONLY:  advec_s_up
-
-    USE advec_ws,                                                              &
-        ONLY:  advec_s_ws 
-
-    USE diffusion_s_mod,                                                       &
-        ONLY:  diffusion_s
-
-    USE indices,                                                               &
-        ONLY:  nxl, nxr, nyn, nys, wall_flags_0
-
-    USE pegrid
-
-    USE surface_mod,                                                           &
-        ONLY:  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h,     &
-               surf_usm_v
+!> Subroutine to read restart data of chemical species
+!------------------------------------------------------------------------------!
+
+    SUBROUTINE chem_rrd_local( i, k, nxlf, nxlc, nxl_on_file, nxrf, nxrc,         &
+                               nxr_on_file, nynf, nync, nyn_on_file, nysf, nysc,  &
+                               nys_on_file, tmp_3d, found )    
+                                        
+       USE control_parameters
+               
+       USE indices
+       
+       USE pegrid
+
+       IMPLICIT NONE 
+
+       CHARACTER (LEN=20) :: spc_name_av !<   
+          
+       INTEGER(iwp) ::  i, lsp          !< 
+       INTEGER(iwp) ::  k               !< 
+       INTEGER(iwp) ::  nxlc            !< 
+       INTEGER(iwp) ::  nxlf            !< 
+       INTEGER(iwp) ::  nxl_on_file     !<   
+       INTEGER(iwp) ::  nxrc            !< 
+       INTEGER(iwp) ::  nxrf            !< 
+       INTEGER(iwp) ::  nxr_on_file     !<   
+       INTEGER(iwp) ::  nync            !< 
+       INTEGER(iwp) ::  nynf            !< 
+       INTEGER(iwp) ::  nyn_on_file     !<   
+       INTEGER(iwp) ::  nysc            !< 
+       INTEGER(iwp) ::  nysf            !< 
+       INTEGER(iwp) ::  nys_on_file     !<   
+       
+       LOGICAL, INTENT(OUT)  :: found 
+
+       REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d   !< 3D array to temp store data
+
+
+       found = .FALSE.  
+
+
+          IF ( ALLOCATED(chem_species) )  THEN
+
+             DO  lsp = 1, nspec
+
+                 !< for time-averaged chemical conc.
+                spc_name_av  =  TRIM(chem_species(lsp)%name)//'_av'
+
+                IF (restart_string(1:length) == TRIM(chem_species(lsp)%name) )    &
+                THEN
+                   !< read data into tmp_3d
+                   IF ( k == 1 )  READ ( 13 )  tmp_3d  
+                   !< fill ..%conc in the restart run    
+                   chem_species(lsp)%conc(:,nysc-nbgp:nync+nbgp,                  &
+                                          nxlc-nbgp:nxrc+nbgp) =                  & 
+                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
+                   found = .TRUE.
+                ELSEIF (restart_string(1:length) == spc_name_av )  THEN
+                   IF ( k == 1 )  READ ( 13 )  tmp_3d
+                   chem_species(lsp)%conc_av(:,nysc-nbgp:nync+nbgp,               &
+                                             nxlc-nbgp:nxrc+nbgp) =               &
+                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
+                   found = .TRUE.
+                ENDIF
+
+             ENDDO
+
+          ENDIF
+
+
+    END SUBROUTINE chem_rrd_local
+!
+!-------------------------------------------------------------------------------!
+!> Description:
+!> Calculation of horizontally averaged profiles
+!> This routine is called for every statistic region (sr) defined by the user,
+!> but at least for the region "total domain" (sr=0).
+!> quantities.
+!------------------------------------------------------------------------------!
+    SUBROUTINE chem_statistics( mode, sr, tn )
+
+
+       USE arrays_3d
+       USE indices
+       USE kinds
+       USE pegrid
+       USE statistics
+
+    USE user
 
     IMPLICIT NONE
 
-    INTEGER ::  i   !< running index
-    INTEGER ::  j   !< running index
-    INTEGER ::  k   !< running index
-
-    INTEGER(iwp),INTENT(IN) ::  ilsp          !<
-
-    REAL(wp), DIMENSION(0:nz+1) ::  pr_init_cs   !<
-
-    REAL(wp), DIMENSION(:,:,:), POINTER ::  cs_scalar      !<
-    REAL(wp), DIMENSION(:,:,:), POINTER ::  cs_scalar_p    !<
-    REAL(wp), DIMENSION(:,:,:), POINTER ::  tcs_scalar_m   !<
-
-
-!
-!-- Tendency terms for chemical species
-    tend = 0.0_wp
-!    
-!-- Advection terms
-    IF ( timestep_scheme(1:5) == 'runge' )  THEN
-       IF ( ws_scheme_sca )  THEN
-          CALL advec_s_ws( cs_scalar, 'kc' )
-       ELSE
-          CALL advec_s_pw( cs_scalar )
-       ENDIF
-    ELSE
-         CALL advec_s_up( cs_scalar )
-    ENDIF
-!
-!-- Diffusion terms  (the last three arguments are zero)
-    CALL diffusion_s( cs_scalar,                                               &
-                      surf_def_h(0)%cssws(ilsp,:),                             &
-                      surf_def_h(1)%cssws(ilsp,:),                             &
-                      surf_def_h(2)%cssws(ilsp,:),                             &
-                      surf_lsm_h%cssws(ilsp,:),                                &
-                      surf_usm_h%cssws(ilsp,:),                                &
-                      surf_def_v(0)%cssws(ilsp,:),                             &
-                      surf_def_v(1)%cssws(ilsp,:),                             &
-                      surf_def_v(2)%cssws(ilsp,:),                             &
-                      surf_def_v(3)%cssws(ilsp,:),                             &
-                      surf_lsm_v(0)%cssws(ilsp,:),                             &
-                      surf_lsm_v(1)%cssws(ilsp,:),                             &
-                      surf_lsm_v(2)%cssws(ilsp,:),                             &
-                      surf_lsm_v(3)%cssws(ilsp,:),                             &
-                      surf_usm_v(0)%cssws(ilsp,:),                             &
-                      surf_usm_v(1)%cssws(ilsp,:),                             &
-                      surf_usm_v(2)%cssws(ilsp,:),                             &
-                      surf_usm_v(3)%cssws(ilsp,:) )
-!    
-!-- Prognostic equation for chemical species
-    DO  i = nxl, nxr
-       DO  j = nys, nyn    
-          DO  k = nzb+1, nzt
-             cs_scalar_p(k,j,i) =   cs_scalar(k,j,i)                           &
-                                  + ( dt_3d  *                                 &
-                                      (   tsc(2) * tend(k,j,i)                 &
-                                        + tsc(3) * tcs_scalar_m(k,j,i)         &
-                                      )                                        & 
-                                    - tsc(5) * rdf_sc(k)                       &
-                                             * ( cs_scalar(k,j,i) - pr_init_cs(k) )    &   
-                                    )                                          &
-                                    * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )       
-
-             IF ( cs_scalar_p(k,j,i) < 0.0_wp )  cs_scalar_p(k,j,i) = 0.1_wp * cs_scalar(k,j,i)
+    CHARACTER (LEN=*) ::  mode   !< 
+
+    INTEGER(iwp) :: i    !< running index on x-axis
+    INTEGER(iwp) :: j    !< running index on y-axis
+    INTEGER(iwp) :: k    !< vertical index counter
+    INTEGER(iwp) :: sr   !< statistical region
+    INTEGER(iwp) :: tn   !< thread number 
+    INTEGER(iwp) :: n    !<
+    INTEGER(iwp) :: m    !<
+    INTEGER(iwp) :: lpr  !< running index chem spcs
+!    REAL(wp),                                                                                      &
+!    DIMENSION(dots_num_palm+1:dots_max) ::                                                         &
+!          ts_value_l   !< 
+
+    IF ( mode == 'profiles' )  THEN
+!
+!--    Sample on how to calculate horizontally averaged profiles of user-
+!--    defined quantities. Each quantity is identified by the index
+!--    "pr_palm+#" where "#" is an integer starting from 1. These
+!--    user-profile-numbers must also be assigned to the respective strings
+!--    given by data_output_pr_cs in routine user_check_data_output_pr.
+!--    hom(:,:,:,:) =  dim-1 = vertical level, dim-2= 1: met-species,2:zu/zw, dim-3 = quantity( e.g.
+!                       w*pt*), dim-4 = statistical region.
+
+       !$OMP DO
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+              DO  k = nzb, nzt+1
+                DO lpr = 1, cs_pr_count
+
+                   sums_l(k,pr_palm+lpr,tn) = sums_l(k,pr_palm+lpr,tn) +    &
+                                                 chem_species(cs_pr_index(lpr))%conc(k,j,i) *       &
+                                                 rmask(j,i,sr)  *                                   &
+                                                 MERGE( 1.0_wp, 0.0_wp,                             &
+                                                 BTEST( wall_flags_0(k,j,i), 22 ) )
+                ENDDO                                                                          
+             ENDDO
           ENDDO
        ENDDO
-    ENDDO
-!
-!-- Calculate tendencies for the next Runge-Kutta step
-    IF ( timestep_scheme(1:5) == 'runge' )  THEN
-       IF ( intermediate_timestep_count == 1 )  THEN
-          DO  i = nxl, nxr
-             DO  j = nys, nyn   
-                DO  k = nzb+1, nzt
-                   tcs_scalar_m(k,j,i) = tend(k,j,i)
-                ENDDO
-             ENDDO
-          ENDDO
-       ELSEIF ( intermediate_timestep_count < &
-          intermediate_timestep_count_max )  THEN
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-                   tcs_scalar_m(k,j,i) = - 9.5625_wp * tend(k,j,i)             &
-                                         + 5.3125_wp * tcs_scalar_m(k,j,i)
-                ENDDO
-             ENDDO
-          ENDDO
-       ENDIF
+    ELSEIF ( mode == 'time_series' )  THEN
+       CALL location_message( 'Time series not calculated for chemistry', .TRUE. )
     ENDIF
 
- END SUBROUTINE chem_prognostic_equations
-
-
+    END SUBROUTINE chem_statistics
+!
 !------------------------------------------------------------------------------!
 !
 ! Description:
 ! ------------
-!> Subroutine defining header output for chemistry model
-!------------------------------------------------------------------------------!
- SUBROUTINE chem_header ( io )
-       
-    IMPLICIT NONE 
- 
-       INTEGER(iwp), INTENT(IN) ::  io            !< Unit of the output file
-
-!      print*,'the header subroutine is still not operational'     
-!!
-!!--    Write chemistry model header
-!       WRITE( io, 3 )
-!
-!       IF ( radiation_scheme == "constant" )  THEN 
-!          WRITE( io, 4 ) net_radiation
-!       ELSEIF ( radiation_scheme == "clear-sky" )  THEN 
-!          WRITE( io, 5 )
-!       ELSEIF ( radiation_scheme == "rrtmg" )  THEN 
-!          WRITE( io, 6 )
-!          IF ( .NOT. lw_radiation )  WRITE( io, 10 ) 
-!          IF ( .NOT. sw_radiation )  WRITE( io, 11 ) 
-!       ENDIF 
-!
-!       IF ( albedo_type == 0 )  THEN 
-!          WRITE( io, 7 ) albedo
-!       ELSE
-!          WRITE( io, 8 ) TRIM( albedo_type_name(albedo_type) )
-!       ENDIF
-!       IF ( constant_albedo )  THEN 
-!          WRITE( io, 9 )
-!       ENDIF
-!     
-!       IF ( radiation .AND. radiation_scheme /= 'constant' )  THEN 
-!          WRITE ( io, 1 )  lambda
-!          WRITE ( io, 2 )  day_init, time_utc_init
-!       ENDIF
-!
-!       WRITE( io, 12 ) dt_radiation
-! 
-! 1 FORMAT ('    Geograph. longitude            :   lambda = ',F4.1,' degr')
-! 2 FORMAT ('    Day of the year at model start :   day_init = ',I3   &
-!            /'    UTC time at model start        :   time_utc_init = ',F7.1' s')
-! 3 FORMAT (//' Radiation model information:'/                                  &
-!              ' ----------------------------'/)
-! 4 FORMAT ('    --> Using constant net radiation: net_radiation = ', F6.2,        &
-!           // 'W/m**2')
-! 5 FORMAT ('    --> Simple radiation scheme for clear sky is used (no clouds,',   &
-!                   ' default)')
-! 6 FORMAT ('    --> RRTMG scheme is used')
-! 7 FORMAT (/'    User-specific surface albedo: albedo =', F6.3)
-! 8 FORMAT (/'    Albedo is set for land surface type: ', A)
-! 9 FORMAT (/'    --> Albedo is fixed during the run')
-!10 FORMAT (/'    --> Longwave radiation is disabled')
-!11 FORMAT (/'    --> Shortwave radiation is disabled.')
-!12 FORMAT  ('    Timestep: dt_radiation = ', F6.2, '  s')
-!
-!
- END SUBROUTINE chem_header
-
-!------------------------------------------------------------------------------
+!> Subroutine for swapping of timelevels for chemical species
+!> called out from subroutine swap_timelevel
+!------------------------------------------------------------------------------!
+
+    SUBROUTINE chem_swap_timelevel (level)
+
+          IMPLICIT   none
+
+          INTEGER,INTENT(IN)        :: level
+!--       local variables
+          INTEGER                   :: lsp
+
+
+          IF ( level == 0 ) THEN
+             DO lsp=1, nvar                                       
+                chem_species(lsp)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)    => spec_conc_1(:,:,:,lsp)
+                chem_species(lsp)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  => spec_conc_2(:,:,:,lsp)
+             ENDDO
+          ELSE
+             DO lsp=1, nvar                                        
+                chem_species(lsp)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg)    => spec_conc_2(:,:,:,lsp)
+                chem_species(lsp)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  => spec_conc_1(:,:,:,lsp)
+             ENDDO
+          ENDIF
+
+       RETURN
+    END SUBROUTINE chem_swap_timelevel
+!
+!------------------------------------------------------------------------------!
+!
 ! Description:
 ! ------------
-!> Subroutine reading restart data for chemistry model input parameters
-!  (FK: To make restarts work, I had to comment this routine. We actually
-!       don't need it, since the namelist parameters are always read in,
-!       also in case of a restart run)
-!------------------------------------------------------------------------------
-!  SUBROUTINE chem_rrd_global
-!
-!    USE chem_modules
-!
-!    USE control_parameters,                                                   &
-!        ONLY: length, message_string, restart_string
-! 
-!     
-!     IMPLICIT NONE
-!     
-!     
-!     
-!     DO
-! 
-!        SELECT CASE ( restart_string(1:length) )
-!        
-!           CASE ( 'bc_cs_b' )
-!              READ ( 13 )  bc_cs_b
-!
-!           CASE DEFAULT
-!
-!              EXIT
-!            
-!        END SELECT
-!        
-!!
-!!--     Read next string and its length
-!        READ ( 13 )  length
-!        READ ( 13 )  restart_string(1:length)
-!        
-!     ENDDO
-!     
-!  END SUBROUTINE chem_rrd_global
-
-
-!------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine writing restart data for chemistry model input parameters
-!  (FK: To make restarts work, I had to comment this routine. We actually
-!       don't need it, since the namelist parameters are always read in,
-!       also in case of a restart run)
-!------------------------------------------------------------------------------!
-!  SUBROUTINE chem_wrd_global
-! 
-!     USE chem_modules
-!     
-!     USE kinds
-! 
-! 
-!     IMPLICIT NONE
-! 
-!     INTEGER(iwp) ::  lsp  !< running index for chem spcs
-! 
-! !
-! !-- Writing out input parameters that are not part of chemistry_parameters 
-! !-- namelist (namelist parameters are anyway read in again in case of restart)
-!     DO lsp = 1, nvar
-!        CALL wrd_write_string( 'conc_pr_init_'//chem_species(lsp)%name )
-!        WRITE ( 14 )  chem_species(lsp)%conc_pr_init
-!     ENDDO
-! 
-! 
-!  END SUBROUTINE chem_wrd_global
-
-
-!------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine for emission
-!------------------------------------------------------------------------------!
- SUBROUTINE chem_emissions
-
-    USE chem_modules
-    
-    USE netcdf_data_input_mod,                                                 &
-        ONLY:  street_type_f
-    
-    USE surface_mod,                                                           &
-        ONLY:  surf_lsm_h
-
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i    !< running index for grid in x-direction
-    INTEGER(iwp) ::  j    !< running index for grid in y-direction
-    INTEGER(iwp) ::  m    !< running index for horizontal surfaces
-    INTEGER(iwp) ::  lsp  !< running index for chem spcs
-
-!
-!-- Comment??? (todo)
-    IF ( street_type_f%from_file )  THEN
-!
-!--    Streets are lsm surfaces, hence, no usm surface treatment required
-       DO  m = 1, surf_lsm_h%ns
-          i = surf_lsm_h%i(m)
-          j = surf_lsm_h%j(m)
-          
-          IF ( street_type_f%var(j,i) >= main_street_id  .AND.                 &
-               street_type_f%var(j,i) < max_street_id )  THEN
-             DO  lsp = 1, nvar
-                surf_lsm_h%cssws(lsp,m) = emiss_factor_main * surface_csflux(lsp)
-             ENDDO
-          ELSEIF ( street_type_f%var(j,i) >= side_street_id  .AND.             &
-                   street_type_f%var(j,i) < main_street_id )  THEN
-             DO  lsp = 1, nvar
-                surf_lsm_h%cssws(lsp,m) = emiss_factor_side * surface_csflux(lsp)
-             ENDDO
-          ELSE
-             surf_lsm_h%cssws(:,m) = 0.0_wp
-          ENDIF
+!> Subroutine to write restart data for chemistry model
+!------------------------------------------------------------------------------!
+    SUBROUTINE chem_wrd_local
+
+       IMPLICIT NONE 
+
+       INTEGER(iwp) ::  lsp !< 
+
+       DO  lsp = 1, nspec
+          CALL wrd_write_string( TRIM( chem_species(lsp)%name ))
+          WRITE ( 14 )  chem_species(lsp)%conc
+          CALL wrd_write_string( TRIM( chem_species(lsp)%name )//'_av' )
+          WRITE ( 14 )  chem_species(lsp)%conc_av
        ENDDO
-       
-    ENDIF
-
- END SUBROUTINE chem_emissions
-
-
+
+    END SUBROUTINE chem_wrd_local
  END MODULE chemistry_model_mod
 
Index: palm/trunk/SOURCE/data_output_2d.f90
===================================================================
--- palm/trunk/SOURCE/data_output_2d.f90	(revision 3297)
+++ palm/trunk/SOURCE/data_output_2d.f90	(revision 3298)
@@ -25,4 +25,8 @@
 ! -----------------
 ! $Id$
+! minor formatting (kanani)
+! chem_data_output_2d subroutine added (basit)
+! 
+! 3294 2018-10-01 02:37:10Z raasch
 ! changes concerning modularization of ocean option
 ! 
@@ -252,6 +256,9 @@
         ONLY:  bulk_cloud_model, bcm_data_output_2d
 
+    USE chemistry_model_mod,                                                   &
+        ONLY:  chem_data_output_2d
+
     USE control_parameters,                                                    &
-        ONLY:  data_output_2d_on_each_pe, data_output_xy,                      &
+        ONLY:  air_chemistry, data_output_2d_on_each_pe, data_output_xy,       &
                data_output_xz, data_output_yz, do2d,                           &
                do2d_xy_last_time, do2d_xy_time_count,                          &
@@ -265,5 +272,5 @@
     USE cpulog,                                                                &
         ONLY:  cpu_log, log_point 
-
+        
     USE gust_mod,                                                              &
         ONLY:  gust_data_output_2d, gust_module_enabled
@@ -1326,4 +1333,8 @@
                 ENDIF
 
+                IF ( .NOT. found  .AND.  air_chemistry )  THEN
+                   CALL chem_data_output_2d( av, do2d(av,if), found, grid, mode, &
+                                             local_pf, two_d, nzb_do, nzt_do, fill_value )
+                ENDIF
 !
 !--             User defined quantities
Index: palm/trunk/SOURCE/data_output_mask.f90
===================================================================
--- palm/trunk/SOURCE/data_output_mask.f90	(revision 3297)
+++ palm/trunk/SOURCE/data_output_mask.f90	(revision 3298)
@@ -25,4 +25,8 @@
 ! -----------------
 ! $Id$
+! Minor formatting (kanani)
+! Call for chem_data_output_mask added (basit)
+! 
+! 3274 2018-09-24 15:42:55Z knoop
 ! Modularization of all bulk cloud physics code components
 ! 
@@ -133,5 +137,5 @@
         ONLY:  e, nc, nr, p, pt, q, qc, ql, ql_c, ql_v, qr, rho_ocean, s, sa,  &
                tend, u, v, vpt, w, d_exner
-    
+
     USE averaging,                                                             &
         ONLY:  e_av, lpt_av, nc_av, nr_av, p_av, pc_av, pr_av, pt_av, q_av,    &
@@ -141,7 +145,10 @@
     USE basic_constants_and_equations_mod,                                     &
         ONLY:  lv_d_cp
-    
+
+    USE chemistry_model_mod,                                                   &
+        ONLY:  chem_data_output_mask
+
     USE control_parameters,                                                    &
-        ONLY:  domask, domask_no, domask_time_count, mask_i,                   &
+        ONLY:  air_chemistry, domask, domask_no, domask_time_count, mask_i,    &
                mask_j, mask_k, mask_size, mask_size_l, mask_start_l,           &
                max_masks, message_string, mid, nz_do3d, simulated_time
@@ -151,5 +158,5 @@
     USE indices,                                                               &
         ONLY:  nbgp, nxl, nxr, nyn, nys, nzb
-        
+
     USE kinds
 
@@ -524,5 +531,4 @@
 
           CASE DEFAULT
-
 !
 !--          Radiation quantity
@@ -532,4 +538,8 @@
              ENDIF
 
+             IF ( air_chemistry )  THEN
+                CALL chem_data_output_mask(av, domask(mid,av,ivar), found,     &
+                                           local_pf )
+             ENDIF
 !
 !--          User defined quantity
Index: palm/trunk/SOURCE/date_and_time_mod.f90
===================================================================
--- palm/trunk/SOURCE/date_and_time_mod.f90	(revision 3297)
+++ palm/trunk/SOURCE/date_and_time_mod.f90	(revision 3298)
@@ -25,4 +25,12 @@
 ! -----------------
 ! $Id$
+! - Minor formatting (kanani)
+! - Added Routines for DEFAULT mode of chemistry emissions (Russo)
+! - Added routine for reading-in real dates: format has to be in DDMMYYYY and 
+!   passed in the namelist parameter date_init (Russo)
+! - Added calculation of several time indices useful in several routines 
+!   of the model (Russo)
+!
+! 2718 2018-01-02 08:49:38Z maronga
 ! Corrected "Former revisions" section
 ! 
@@ -46,38 +54,115 @@
 !> This routine calculates all needed information on date and time used by
 !> other modules
+!> @todo Further testing and revision of routines for updating indices of 
+!>       emissions in the default mode 
+!> @todo Add routine for recognizing leap years 
+!> @todo Add recognition of exact days of week (Monday, Tuesday, etc.)
+!> @todo Reconsider whether to remove day_of_year_init from the namelist: we 
+!>       already implemented changes for calculating it from date_init in 
+!>       calc_date_and_time
 !------------------------------------------------------------------------------!
  MODULE date_and_time_mod
- 
-    USE control_parameters,                                                    &
-        ONLY: time_since_reference_point 
- 
+
+    USE control_parameters,                                                   &
+        ONLY:  coupling_start_time, days_since_reference_point,               &
+               message_string, simulated_time, time_since_reference_point
+
     USE kinds
 
+
     IMPLICIT NONE
 
     PRIVATE
-    
-    PUBLIC   calc_date_and_time, d_hours_day, d_seconds_hour, d_seconds_year,  &
-             day_of_year, day_of_year_init, time_utc, time_utc_init
-
-
-    INTEGER(iwp) ::  day_of_year              !< day of the year (DOY)
-    INTEGER(iwp) ::  day_of_year_init = 172   !< DOY at model start (default: 21 June)
-
-    REAL(wp) ::  time_utc                     !< current model time in UTC
-    REAL(wp) ::  time_utc_init = 43200.0_wp   !< UTC time at model start
-
+
+!-- Variables Declaration
+
+    INTEGER(iwp)        ::  day_of_year      = 0   !< day of the year (DOY)
+    INTEGER(iwp)        ::  day_of_year_init = 0   !< DOY at model start (default: 0)
+
+    ! --- Most of these indices are updated by the routine calc_date_and_time according to the current date and time of the simulation
+    INTEGER(iwp)        ::  hour_of_year = 1                        !< hour of the current year (1:8760(8784))
+    INTEGER(iwp)        ::  hour_of_day=1                           !< hour of the current day (1:24)
+    INTEGER(iwp)        ::  day_of_month=0                          !< day of the current month (1:31)
+    INTEGER(iwp)        ::  month_of_year=0                         !< month of the current year (1:12)
+    INTEGER(iwp)        ::  current_year=0                          !< current year
+    INTEGER(iwp)        ::  hour_call_emis=0                        !< index used to call the emissions just once every hour
+
+    INTEGER(iwp)        ::  ihour            
+    INTEGER(iwp)        ::  index_mm                                !< index months of the default emission mode
+    INTEGER(iwp)        ::  index_dd                                !< index days of the default emission mode
+    INTEGER(iwp)        ::  index_hh                                !< index hours of the default emission mode
+
+    REAL(wp)            ::  time_utc                     !< current model time in UTC
+    REAL(wp)            ::  time_utc_emis                !< current emission module time in UTC
+    REAL(wp)            ::  time_utc_init = 43200.0_wp   !< UTC time at model start
+    REAL(wp)            ::  time_update                  !< used to calculate actual second of the simulation
+ 
     REAL(wp), PARAMETER ::  d_hours_day    = 1.0_wp / 24.0_wp       !< inverse of hours per day (1/24)
     REAL(wp), PARAMETER ::  d_seconds_hour = 1.0_wp / 3600.0_wp     !< inverse of seconds per hour (1/3600)
     REAL(wp), PARAMETER ::  d_seconds_year = 1.0_wp / 31536000.0_wp !< inverse of the seconds per year (1/(365*86400))
     
+    CHARACTER(len=8)    ::  date_init = "31122018"                  !< Starting date of simulation: We selected this because it was a monday
+ 
+    !> --- Parameters
+    INTEGER, PARAMETER, DIMENSION(12) :: days = (/31,28,31,30,31,30,31,31,30,31,30,31/) ! total number of days for each month (no leap year)
+
     SAVE
 
+!-- INTERFACES PART
+    !-- Read initial day and time of simulation
+    INTERFACE init_date_and_time
+       MODULE PROCEDURE init_date_and_time
+    END INTERFACE init_date_and_time
+
+    !-- Get hour index in the DEAFULT case of chemistry emissions :
+    INTERFACE time_default_indices
+       MODULE PROCEDURE time_mdh_indices
+       MODULE PROCEDURE time_hour_indices
+    END INTERFACE time_default_indices
+
+    !-- Calculate current date and time
+    INTERFACE calc_date_and_time
+       MODULE PROCEDURE calc_date_and_time
+    END INTERFACE
+
+
+    !-- Public Interfaces
+    PUBLIC calc_date_and_time, time_default_indices, init_date_and_time
+
+    !-- Public Variables
+    PUBLIC date_init, d_hours_day, d_seconds_hour, d_seconds_year,               &
+           day_of_year, day_of_year_init, time_utc, time_utc_init, day_of_month, &
+           month_of_year, index_mm, index_dd, index_hh, hour_of_day, hour_of_year, &
+           hour_call_emis
+
  CONTAINS
+
+
+ !------------------------------------------------------------------------------!
+ !> Reads starting date from namelist
+ !------------------------------------------------------------------------------!
+  
+    SUBROUTINE init_date_and_time
+
+       IMPLICIT NONE
+
+       IF  (day_of_year_init == 0) THEN
+          ! Day of the month at starting time
+          READ(UNIT=date_init(1:2),fmt=*)day_of_month
+
+          ! Month of the year at starting time
+          READ(UNIT=date_init(3:4),fmt=*)month_of_year
+
+          ! Year at starting time
+          READ(UNIT=date_init(5:8),fmt=*)current_year
+       
+       ENDIF
+
+    END SUBROUTINE init_date_and_time
 
 !------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> Calculate current day of the year and time in UTC
+!> Calculate current date and time of the simulation 
 !------------------------------------------------------------------------------!
  
@@ -86,16 +171,255 @@
        IMPLICIT NONE
 
-!
-!--    Calculate current day of the year 
-       day_of_year = day_of_year_init + INT(FLOOR( (time_utc_init + time_since_reference_point)&
-                               / 86400.0_wp ), KIND=iwp)
-                        
+!--    Variables Definition
+       INTEGER		   		:: i_mon       !< Index for going through the different months
+
+       !> Update simulation time in seconds
+       time_update = simulated_time-coupling_start_time
+
+!--    Calculate current day of the simulated time
+       days_since_reference_point=INT(FLOOR( (time_utc_init + time_update) &
+                               / 86400.0_wp ) )
+
+!--    Calculate actual UTC time                        
        time_utc = MOD((time_utc_init + time_since_reference_point), 86400.0_wp)
        
+!sB    PRILIMINARY workaround for time_utc bug concerning time_since_reference_point:
+       time_utc_emis = MOD((time_utc_init + time_update), 86400.0_wp)     
+
+!--    Calculate initial day of the year: it is calculated only once. In fact, day_of_year_init is initialized to 0 and then a positive value is passed. This condition is also called only when day_of_year_init is not given in the namelist. 
+
+       IF ( day_of_year_init == 0 ) THEN
+
+          !> Condition for printing an error when date_init is not provided when day_of_year_init is not given in the namelist or when the format of the date is not the one required by PALM. 
+          IF ( day_of_month .GT. 0 .AND. day_of_month .LE. 31 .AND. month_of_year .GT. 0 .AND. month_of_year .LE. 12) THEN
+        
+             IF ( month_of_year == 1 ) THEN  !!month of year is read in input
+
+                day_of_year_init = day_of_month
+
+             ELSE
+
+                day_of_year_init= SUM(days( 1:(month_of_year-1) )) + day_of_month  !day_of_month is read in input in this case
+
+             ENDIF
+!kanani: Revise, we cannot force users to provide date_init, maybe set a default value?
+!           ELSE
+! 
+!              message_string = 'date_init not provided in the namelist or'             //          &
+!                               ' given in the wrong format: MUST BE DDMMYYYY'                        
+!              CALL message( 'calc_date_and_time', 'DT0100', 2, 2, 0, 6, 0 ) 
+     
+          ENDIF
+
+       ENDIF
+
+      !-- Calculate actual hour of the day: the first hour of the day is from 00:00:00 to 00:59:59. 
+
+      hour_of_day = INT( FLOOR( time_utc_emis/3600.0_wp ) ) + 1
+
+!--    Calculate current day of the year !TBD: considetr leap years
+       IF ( (day_of_year_init + days_since_reference_point)  .GT. 365 ) THEN
+
+          day_of_year=INT(MOD((day_of_year_init + days_since_reference_point), 365.0_wp))
+
+       ELSE
+          
+          day_of_year = day_of_year_init + days_since_reference_point
+
+       ENDIF
+
+!
+!--    Calculate current hour of the year
+       hour_of_year = ( (day_of_year-1) * 24 ) + hour_of_day  !> actual hour of the year
+        
+
+!
+!--    UPDATE actual day of the month and month of the year
+       !> --------------------------------------------------------------------------------
+       !> The first case is when date_init is not provided: we only know day_of_year_init      
+       IF ( month_of_year == 0 .AND. day_of_month == 0) THEN
+
+          !> The first case is when date_init is not provided: we only know day_of_year_init
+          !DO i_mon=1,12
+             !IF (day_of_year .LE. SUM(days(1:i_mon))) THEN
+          IF ( day_of_year .LE. 31 ) THEN
+
+             month_of_year=1
+             day_of_month=day_of_year
+
+          ELSE
+
+             DO i_mon=2,12   !january is considered in the first case
+                IF ( day_of_year .LE. SUM(days(1:i_mon)) .AND. day_of_year .GT. SUM(days(1:(i_mon-1))) ) THEN
+           
+                   month_of_year=i_mon
+
+                   day_of_month=INT(MOD(day_of_year, SUM(days(1:(i_mon-1))))) 
+
+                   GOTO 38
+
+                ENDIF
+
+             38 ENDDO
+          ENDIF
+       !> --------------------------------------------------------------------------------
+       !> in the second condition both day of month and month_of_year are either given in input (passed to date_init) or we are in some day successive to the initial one, so that day_of_month has already be computed in previous step
+       !>TBD: something to calculate the current year is missing
+       ELSEIF ( day_of_month .GT. 0 .AND. day_of_month .LE. 31 .AND. month_of_year .GT. 0 .AND. month_of_year .LE. 12) THEN
+ 
+          !> calculate month_of_year. TBD: test the condition when day_of_year==31
+ 
+          IF (day_of_year==1) THEN  !> this allows to turn from december to January when passing from a year to another
+ 
+             month_of_year = 1
+        
+          ELSE IF (day_of_year .GT. 1 .AND. day_of_year .GT. SUM(days(1:month_of_year))) THEN
+
+             month_of_year = month_of_year + 1
+
+          ENDIF
+
+          !> calculate day_of_month
+          IF ( month_of_year == 1 ) THEN
+           
+            day_of_month=day_of_year
+
+          ELSE
+
+            day_of_month=INT(MOD(day_of_year, SUM(days(1:(month_of_year-1)))))
+
+          ENDIF
+
+
+
+
+      ELSE
+
+          !> Condition when date_init is provided but it is given in the wrong format
+          message_string = 'date_init not provided in the namelist or'            //          &
+                              ' given in the wrong format: MUST BE DDMMYYYY'                  
+          CALL message( 'calc_date_and_time', 'DT0101', 2, 2, 0, 6, 0 ) 
+
+      ENDIF       
+      
+    END SUBROUTINE calc_date_and_time
+
+!TBD: check the routines used for update of emission indices in the DEFAULT MODE 
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> This routine determines the time factor index in the mdh case of the DEFAULT chemistry emissions mode.
+!------------------------------------------------------------------------------!
+
+ SUBROUTINE time_mdh_indices(daytype_mdh,mo, dd, hh, index_mm, index_dd, index_hh)
+
+    USE indices
+
+    IMPLICIT NONE
+
+    !> IN/OUTPUT
+    INTEGER, INTENT(INOUT) :: mo          !> Month of year
+    INTEGER, INTENT(INOUT) :: dd          !> Day of month
+    INTEGER, INTENT(INOUT) :: hh          !> Hour of day
+    INTEGER, INTENT(INOUT) :: index_mm    !> Index Month
+    INTEGER, INTENT(INOUT) :: index_dd    !> Index Day
+    INTEGER, INTENT(INOUT) :: index_hh    !> Index Hour
+
+    CHARACTER(len=80), INTENT(INOUT) :: daytype_mdh !> type of the day in mdh mode: one of 1-WORKDAY
+                                                    !                                      2-WEEKEND
+                                                    !                                      3-HOLIDAY
+
+    REAL(wp)                         :: frac_day=0  
+
+    !> ------------------------------------------------------------------------
+
+    INTEGER                	     :: weekday
+
+    !> CONSTANTS
+    INTEGER, PARAMETER               :: nmonth = 12
+    INTEGER, PARAMETER               :: nday = 7
+    INTEGER, PARAMETER               :: nhour = 24
+
+    frac_day= (dd-1)/nday    !> indicates the week of the month, supposing the month starts on monday
+
+   ! 1:7      1:31  7                   (0:30)/7
+    weekday = dd-( nday * (INT( CEILING( frac_day ) ) ) ) ! for now we let the year start on Monday. 
+
+    !TBD: set weekday correct based on date
+    index_mm = mo
+    index_dd = nmonth + weekday  !> Index of the days in the mdh mode (13:20)
+
+    SELECT CASE(TRIM(daytype_mdh))
+
+		   CASE ("workday")
+	       
+	           index_hh = nmonth+ nday + hh 
+
+		   CASE ("weekend")
+	       
+	           index_hh = nmonth+ nday + nhour + hh 
+
+		   CASE ("holiday")
+	       
+	           index_hh = nmonth+ nday + 2*nhour + hh 
+    END SELECT
+
+
+ END SUBROUTINE time_mdh_indices
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> This routine determines the time factor index in the HOURLY case of the DEFAULT emissions mode.
+!------------------------------------------------------------------------------!
+
+ SUBROUTINE time_hour_indices(mo,dd,hh,index_hh)
+
+    USE indices
+
+    IMPLICIT NONE
+
+    !> IN/OUTPUT
+    INTEGER, INTENT(INOUT) 		:: mo          !> Month
+    INTEGER, INTENT(INOUT) 		:: hh          !> Hour
+    INTEGER, INTENT(INOUT) 		:: dd          !> Day
+    INTEGER, INTENT(INOUT) 		:: index_hh    !> Index Hour
+ 
+    !> Additional Variables for calculateing indices
+    INTEGER		   		:: index_mm    !> Index Month
+    INTEGER		   		:: index_dd    !> Index Day
+    INTEGER		   		:: i_mon       !> Index for going through the different months
+    INTEGER		   		:: sum_dd      !> Sum days
+
+    !> CONSTANTS
+    INTEGER, PARAMETER 			:: nmonth=12
+    INTEGER, PARAMETER 			:: nday = 7
+    INTEGER, PARAMETER 			:: nhour = 24
+    INTEGER, PARAMETER, DIMENSION(12)   :: days = (/31,28,31,30,31,30,31,31,30,31,30,31/) ! no leap year
+    
+
+    index_mm = mo-1
+    index_dd = dd-1
+    sum_dd=0
+
+    IF (mo == 1) THEN
+
+       index_hh=(index_dd*nhour)+hh
+
+    ELSE 
+
+    	DO i_mon=1,index_mm
        
-
-    END SUBROUTINE calc_date_and_time
-
-
-
- END MODULE date_and_time_mod
+            sum_dd=sum_dd+days(i_mon)
+
+        ENDDO
+      
+    index_hh=(sum_dd*nhour)+(index_dd*nhour)+(hh)
+
+    ENDIF
+ 
+
+ END SUBROUTINE time_hour_indices
+
+
+END MODULE date_and_time_mod
Index: palm/trunk/SOURCE/flow_statistics.f90
===================================================================
--- palm/trunk/SOURCE/flow_statistics.f90	(revision 3297)
+++ palm/trunk/SOURCE/flow_statistics.f90	(revision 3298)
@@ -19,5 +19,5 @@
 !
 ! Current revisions:
-! -----------------
+! ------------------
 ! 
 ! 
@@ -25,4 +25,11 @@
 ! -----------------
 ! $Id$
+! - Minor formatting (kanani)
+! - Added  .AND. max_pr_cs > 0 before MPI_ALLREDUCE call (forkel)
+! - Data arrays, sums, sums_l, hom, hom_sum updated for chem species (basit)
+! - Directives of parallelism added for chemistry (basit)
+! - Call for chem_statistics added (basit)
+!
+! 3294 2018-10-01 02:37:10Z raasch
 ! ocean renamed ocean_mode
 ! 
@@ -283,5 +290,5 @@
 !------------------------------------------------------------------------------!
  SUBROUTINE flow_statistics
- 
+
 
     USE arrays_3d,                                                             &
@@ -291,10 +298,17 @@
                sa, u, ug, v, vg, vpt, w, w_subs, waterflux_output_conversion,  &
                zw, d_exner
-        
+
     USE basic_constants_and_equations_mod,                                     &
-        ONLY:   g, lv_d_cp
-        
+        ONLY:  g, lv_d_cp
+
+
+    USE chem_modules,                                                          &
+        ONLY:  max_pr_cs
+
+    USE chemistry_model_mod,                                                   &
+        ONLY:  chem_species, chem_statistics
+
     USE control_parameters,                                                    &
-        ONLY:   average_count_pr, cloud_droplets, do_sum,                      &
+        ONLY:   air_chemistry, average_count_pr, cloud_droplets, do_sum,       &
                 dt_3d, humidity, initializing_actions, land_surface,           &
                 large_scale_forcing, large_scale_subsidence, max_pr_user,      &
@@ -303,8 +317,8 @@
                 use_subsidence_tendencies, use_surface_fluxes, use_top_fluxes, &
                 ws_scheme_mom, ws_scheme_sca
-        
+
     USE cpulog,                                                                &
         ONLY:   cpu_log, log_point
-        
+
     USE grid_variables,                                                        &
         ONLY:   ddx, ddy
@@ -1780,4 +1794,9 @@
        ENDIF
 !
+!--    Calculate the chemistry module profiles
+       IF ( air_chemistry ) THEN
+          CALL chem_statistics( 'profiles', sr, tn )
+       ENDIF
+!
 !--    Calculate the user-defined profiles
        CALL user_statistics( 'profiles', sr, tn )
@@ -1797,4 +1816,13 @@
                                    sums_l(:,pr_palm+1:pr_palm+max_pr_user,i)
              ENDIF
+
+             IF ( air_chemistry )  THEN
+                IF ( max_pr_cs > 0 )  THEN                                 
+                     sums_l(:,pr_palm+max_pr_user+1:pr_palm + max_pr_user+ max_pr_cs,0) =          &
+                               sums_l(:,pr_palm+max_pr_user+1:pr_palm + max_pr_user+max_pr_cs,0) + &
+                               sums_l(:,pr_palm+max_pr_user+1:pr_palm + max_pr_user+max_pr_cs,i)
+
+                ENDIF
+             ENDIF
           ENDDO
        ENDIF
@@ -1811,4 +1839,11 @@
                               MPI_REAL, MPI_SUM, comm2d, ierr )
        ENDIF
+
+       IF ( air_chemistry .AND. max_pr_cs > 0 )  THEN
+          IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
+             CALL MPI_ALLREDUCE( sums_l(nzb,pr_palm+1,0), sums(nzb,pr_palm+1), &
+                                 nzt+2-nzb, MPI_REAL, MPI_SUM, comm2d, ierr )
+       ENDIF
+
 #else
        sums = sums_l(:,:,0)
@@ -1875,4 +1910,14 @@
                                     ngp_2dh_s_inner(k,sr)
           ENDDO
+       ENDIF
+
+       IF ( air_chemistry ) THEN
+          IF ( max_pr_cs > 0 )  THEN                  
+             DO k = nzb, nzt+1
+                sums(k, pr_palm+1:pr_palm+max_pr_user+max_pr_cs) = &
+                                 sums(k, pr_palm+1:pr_palm+max_pr_user+max_pr_cs) / &
+                                 ngp_2dh_s_inner(k,sr)
+             ENDDO
+          ENDIF  
        ENDIF
 
@@ -2018,4 +2063,10 @@
        ENDIF
 
+       IF ( air_chemistry )  THEN
+          IF ( max_pr_cs > 0 )  THEN    ! chem_spcs profiles      
+             hom(:, 1, pr_palm+max_pr_user+1:pr_palm + max_pr_user+max_pr_cs, sr) = &
+                               sums(:, pr_palm+max_pr_user+1:pr_palm+max_pr_user+max_pr_cs)
+          ENDIF
+       ENDIF
 !
 !--    Determine the boundary layer height using two different schemes.
Index: palm/trunk/SOURCE/header.f90
===================================================================
--- palm/trunk/SOURCE/header.f90	(revision 3297)
+++ palm/trunk/SOURCE/header.f90	(revision 3298)
@@ -25,4 +25,8 @@
 ! -----------------
 ! $Id$
+! Minor formatting (kanani)
+! Add chemistry header (basit)
+!
+! 3294 2018-10-01 02:37:10Z raasch
 ! changes concerning modularization of ocean option
 ! 
@@ -391,9 +395,12 @@
         ONLY:  bulk_cloud_model, bcm_header
 
+    USE chemistry_model_mod,                                                   &
+        ONLY:  chem_header
+
     USE control_parameters
 
     USE cpulog,                                                                &
         ONLY:  log_point_s
-            
+
     USE date_and_time_mod,                                                     &
         ONLY:  day_of_year_init, time_utc_init
@@ -1123,4 +1130,5 @@
     IF ( gust_module_enabled )  CALL gust_header ( io )
 
+    IF ( air_chemistry )  CALL chem_header ( io )
 !
 !-- Boundary conditions
Index: palm/trunk/SOURCE/init_3d_model.f90
===================================================================
--- palm/trunk/SOURCE/init_3d_model.f90	(revision 3297)
+++ palm/trunk/SOURCE/init_3d_model.f90	(revision 3298)
@@ -25,4 +25,8 @@
 ! -----------------
 ! $Id$
+! Minor formatting (kanani)
+! Added CALL to the chem_emissions module (Russo)
+! 
+! 3294 2018-10-01 02:37:10Z raasch
 ! changes concerning modularization of ocean option
 ! 
@@ -501,5 +505,5 @@
 !------------------------------------------------------------------------------!
  SUBROUTINE init_3d_model
- 
+
 
     USE advec_ws
@@ -514,12 +518,15 @@
         ONLY:  bulk_cloud_model, bcm_init, bcm_init_arrays
 
-    USE chemistry_model_mod,                                                   &
-        ONLY:  chem_emissions
+    USE chem_emissions_mod,                                                    &
+        ONLY:  chem_emissions_init
+
+    USE chem_modules,                                                          &
+        ONLY:  do_emis, max_pr_cs, nspec_out
 
     USE control_parameters
-    
+
     USE flight_mod,                                                            &
         ONLY:  flight_init
-    
+
     USE grid_variables,                                                        &
         ONLY:  dx, dy, ddx2_mg, ddy2_mg
@@ -551,14 +558,15 @@
 
     USE netcdf_data_input_mod,                                                 &
-        ONLY:  init_3d, netcdf_data_input_init_3d
+        ONLY:  chem_emis, chem_emis_att, init_3d,                              &
+               netcdf_data_input_init_3d, netcdf_data_input_interpolate
 
     USE ocean_mod,                                                             &
         ONLY:  ocean_init, ocean_init_arrays
-    
+
     USE particle_attributes,                                                   &
         ONLY:  particle_advection
-    
+
     USE pegrid
-    
+
     USE plant_canopy_model_mod,                                                &
         ONLY:  pcm_init
@@ -2261,9 +2269,8 @@
 !
 !-- If required, set chemical emissions
-!-- (todo(FK): This should later on be CALLed time-dependently in init_3d_model)
-    IF ( air_chemistry )  THEN
-       CALL chem_emissions
-    ENDIF
-
+!-- Initialize values of cssws according to chemistry emission values
+    IF ( air_chemistry  .AND.  do_emis )  THEN
+       CALL chem_emissions_init( chem_emis_att, chem_emis, nspec_out )
+    ENDIF
 !
 !-- Initialize radiation processes
Index: palm/trunk/SOURCE/modules.f90
===================================================================
--- palm/trunk/SOURCE/modules.f90	(revision 3297)
+++ palm/trunk/SOURCE/modules.f90	(revision 3298)
@@ -25,4 +25,8 @@
 ! -----------------
 ! $Id$
+! Minor formatting/clean-up (kanani)
+! Added some variables for time treatment (Russo)
+!
+! 3294 2018-10-01 02:37:10Z raasch
 ! ocean renamed ocean_mode
 ! 
@@ -1401,4 +1405,6 @@
     REAL(wp) ::  cos_alpha_surface                             !< cosine of alpha_surface
     REAL(wp) ::  coupling_start_time = 0.0_wp                  !< namelist parameter
+    REAL(wp) ::  days_since_reference_point = 0.0_wp           !< days after atmosphere-ocean coupling has been activated, 
+                                                               !< or after spinup phase of LSM has been finished 
     REAL(wp) ::  disturbance_amplitude = 0.25_wp               !< namelist parameter
     REAL(wp) ::  disturbance_energy_limit = 0.01_wp            !< namelist parameter
Index: palm/trunk/SOURCE/netcdf_data_input_mod.f90
===================================================================
--- palm/trunk/SOURCE/netcdf_data_input_mod.f90	(revision 3297)
+++ palm/trunk/SOURCE/netcdf_data_input_mod.f90	(revision 3298)
@@ -25,4 +25,10 @@
 ! -----------------
 ! $Id$
+! Modified EXPERT mode to PRE-PROCESSED mode (Russo)
+! Introduced Chemistry static netcdf file (Russo)
+! Added the routine for reading-in netcdf data for chemistry (Russo)
+! Added routines to get_variable interface specific for chemistry files (Russo)
+!
+! 3257 2018-09-17 17:11:46Z suehring
 ! Adjust checks for building_type and building_id, which is necessary after 
 ! topography filtering (building_type and id can be modified by the filtering).
@@ -189,5 +195,5 @@
 !> Modulue contains routines to input data according to Palm input data
 !> standart using dynamic and static input files.
-!>
+!> @todo - Review Reading of netcdf files for chemistry
 !> @todo - Order input alphabetically
 !> @todo - Revise error messages and error numbers
@@ -341,4 +347,62 @@
 
     END TYPE init_type
+
+!-- Data type for the general information of chemistry emissions, do not dependent on the particular chemical species
+    TYPE chem_emis_att_type 
+
+       !-DIMENSIONS
+       INTEGER(iwp)                                 :: nspec                     !< number of chem species for which emission values are provided
+       INTEGER(iwp)                                 :: ncat                      !< number of emission categories
+       INTEGER(iwp)                                 :: nvoc                      !< number of VOCs components
+       INTEGER(iwp)                                 :: npm                       !< number of PMs components
+       INTEGER(iwp)                                 :: nnox=2                    !< number of NOx components: NO and NO2
+       INTEGER(iwp)                                 :: nsox=2                    !< number of SOx components: SO and SO4
+       INTEGER(iwp)                                 :: nhoursyear                !< number of hours of a specific year in the HOURLY mode
+                                                                                 !  of the default mode
+       INTEGER(iwp)                                 :: nmonthdayhour             !< number of month days and hours in the MDH mode 
+                                                                                 !  of the default mode
+       INTEGER(iwp)                                 :: dt_emission               !< Number of emissions timesteps for one year 
+                                                                                 !  in the pre-processed emissions case
+       !-- 1d emission input variables
+       CHARACTER (LEN=25),ALLOCATABLE, DIMENSION(:) :: pm_name                   !< Names of PMs components
+       CHARACTER (LEN=25),ALLOCATABLE, DIMENSION(:) :: cat_name                  !< Emission categories names
+       CHARACTER (LEN=25),ALLOCATABLE, DIMENSION(:) :: species_name              !< Names of emission chemical species
+       CHARACTER (LEN=25),ALLOCATABLE, DIMENSION(:) :: voc_name                  !< Names of VOCs components
+       CHARACTER (LEN=25)                           :: units                     !< Units
+
+       INTEGER(iwp)                                 :: i_hour                    !< indices for assigning the emission values at different timesteps
+       INTEGER(iwp),ALLOCATABLE, DIMENSION(:)       :: cat_index                 !< Index of emission categories
+       INTEGER(iwp),ALLOCATABLE, DIMENSION(:)       :: species_index             !< Index of emission chem species
+
+       REAL(wp), DIMENSION(24)                      :: par_emis_time_factor      !< time factors 
+                                                                                 !  for the parameterized mode: these are fixed for each hour
+                                                                                 !  of a single day.
+       REAL(wp),ALLOCATABLE, DIMENSION(:)           :: xm                        !< Molecular masses of emission chem species
+
+       !-- 2d emission input variables 
+       REAL(wp),ALLOCATABLE, DIMENSION(:,:)         :: hourly_emis_time_factor   !< Time factors for HOURLY emissions (DEFAULT mode)
+       REAL(wp),ALLOCATABLE, DIMENSION(:,:)         :: mdh_emis_time_factor      !< Time factors for MDH emissions (DEFAULT mode)
+       REAL(wp),ALLOCATABLE, DIMENSION(:,:)         :: nox_comp                  !< Composition of NO and NO2 
+       REAL(wp),ALLOCATABLE, DIMENSION(:,:)         :: sox_comp                  !< Composition of SO2 and SO4
+       REAL(wp),ALLOCATABLE, DIMENSION(:,:)         :: voc_comp                  !< Composition of different VOC components (number not fixed)
+
+       !-- 3d emission input variables
+       REAL(wp),ALLOCATABLE, DIMENSION(:,:,:)       :: pm_comp                   !< Composition of different PMs components (number not fixed) 
+  
+    END TYPE chem_emis_att_type
+
+
+!-- Data type for the values of chemistry emissions ERUSSO
+    TYPE chem_emis_val_type 
+
+       !REAL(wp),ALLOCATABLE, DIMENSION(:,:)         :: stack_height              !< stack height
+
+       !-- 3d emission input variables
+       REAL(wp),ALLOCATABLE, DIMENSION(:,:,:)     :: default_emission_data     !< Input Values emissions DEFAULT mode
+
+       !-- 4d emission input variables 
+       REAL(wp),ALLOCATABLE, DIMENSION(:,:,:,:)   :: preproc_emission_data      !< Input Values emissions PRE-PROCESSED mode
+
+    END TYPE chem_emis_val_type
 
 !
@@ -546,4 +610,6 @@
     TYPE(pars)  ::  water_pars_f               !< input variable for water parameters
 
+    TYPE(chem_emis_att_type)                             ::  chem_emis_att    !< Input Information of Chemistry Emission Data from netcdf  
+    TYPE(chem_emis_val_type), ALLOCATABLE, DIMENSION(:)  ::  chem_emis        !< Input Chemistry Emission Data from netcdf  
 
     CHARACTER(LEN=3)  ::  char_lod  = 'lod'         !< name of level-of-detail attribute in NetCDF file
@@ -553,4 +619,9 @@
     CHARACTER(LEN=100) ::  input_file_static  = 'PIDS_STATIC'  !< Name of file which comprises static input data
     CHARACTER(LEN=100) ::  input_file_dynamic = 'PIDS_DYNAMIC' !< Name of file which comprises dynamic input data
+    CHARACTER(LEN=100) ::  input_file_chem    = 'PIDS_CHEM'    !< Name of file which comprises chemistry input data
+
+    CHARACTER (LEN=25), ALLOCATABLE, DIMENSION(:)    :: string_values  !< output of string variables read from netcdf input files
+ 
+    INTEGER(iwp)                                     :: id_emis        !< NetCDF id of input file for chemistry emissions: TBD: It has to be removed
 
     INTEGER(iwp) ::  nc_stat         !< return value of nf90 function call
@@ -558,4 +629,5 @@
     LOGICAL ::  input_pids_static  = .FALSE.   !< Flag indicating whether Palm-input-data-standard file containing static information exists
     LOGICAL ::  input_pids_dynamic = .FALSE.   !< Flag indicating whether Palm-input-data-standard file containing dynamic information exists
+    LOGICAL ::  input_pids_chem = .FALSE.      !< Flag indicating whether Palm-input-data-standard file containing chemistry information exists
 
     LOGICAL ::  collective_read = .FALSE.      !< Enable NetCDF collective read
@@ -581,4 +653,8 @@
        MODULE PROCEDURE netcdf_data_input_check_static
     END INTERFACE netcdf_data_input_check_static
+
+    INTERFACE netcdf_data_input_chemistry_data                        
+       MODULE PROCEDURE netcdf_data_input_chemistry_data
+    END INTERFACE netcdf_data_input_chemistry_data
 
     INTERFACE netcdf_data_input_inquire_file
@@ -611,4 +687,5 @@
 
     INTERFACE get_variable
+       MODULE PROCEDURE get_variable_string
        MODULE PROCEDURE get_variable_1d_int
        MODULE PROCEDURE get_variable_1d_real
@@ -619,5 +696,7 @@
        MODULE PROCEDURE get_variable_3d_real
        MODULE PROCEDURE get_variable_3d_real_dynamic
+       MODULE PROCEDURE get_variable_4d_to_3d_real
        MODULE PROCEDURE get_variable_4d_real
+       MODULE PROCEDURE get_variable_5d_to_4d_real
     END INTERFACE get_variable
 
@@ -636,6 +715,7 @@
 !-- Public variables
     PUBLIC albedo_pars_f, albedo_type_f, basal_area_density_f, buildings_f,    &
-           building_id_f, building_pars_f, building_type_f, init_3d,           &
-           init_model, input_file_static, input_pids_static,                   &
+           building_id_f, building_pars_f, building_type_f,                    &
+           chem_emis, chem_emis_att, chem_emis_att_type, chem_emis_val_type,   &
+           init_3d, init_model, input_file_static, input_pids_static,          &
            input_pids_dynamic, leaf_area_density_f, nest_offl,                 &
            pavement_pars_f, pavement_subsurface_pars_f, pavement_type_f,       &
@@ -648,5 +728,5 @@
 !-- Public subroutines
     PUBLIC netcdf_data_input_check_dynamic, netcdf_data_input_check_static,    &
-           netcdf_data_input_inquire_file,                                     &
+           netcdf_data_input_chemistry_data, netcdf_data_input_inquire_file,                                     &
            netcdf_data_input_init, netcdf_data_input_init_lsm,                 &
            netcdf_data_input_init_3d,                                          &
@@ -674,4 +754,7 @@
        INQUIRE( FILE = TRIM( input_file_dynamic ) // TRIM( coupling_char ),    &
                 EXIST = input_pids_dynamic )
+       INQUIRE( FILE = TRIM( input_file_chem ) // TRIM( coupling_char ),    &
+                EXIST = input_pids_chem )
+
 #endif
 
@@ -756,4 +839,296 @@
 
     END SUBROUTINE netcdf_data_input_init
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Reads Chemistry NETCDF Input data, such as emission values, emission species, etc. .
+!------------------------------------------------------------------------------!
+    SUBROUTINE netcdf_data_input_chemistry_data(emt_att,emt)
+
+       USE chem_modules,                                       &
+           ONLY:  do_emis, mode_emis, time_fac_type,           & 
+                  surface_csflux_name 
+
+       USE control_parameters,                                 &
+           ONLY:  message_string
+
+       USE indices,                                            &
+           ONLY:  nz, nx, ny, nxl, nxr, nys, nyn, nzb, nzt
+
+       IMPLICIT NONE
+
+       TYPE(chem_emis_att_type), INTENT(INOUT)                                        :: emt_att
+       TYPE(chem_emis_val_type), ALLOCATABLE, DIMENSION(:), INTENT(INOUT)             :: emt
+    
+       CHARACTER (LEN=80)                               :: units=''              !< units of chemistry inputs
+ 
+       INTEGER(iwp)                                     :: ispec                 !< index for number of emission species in input
+
+       INTEGER(iwp), ALLOCATABLE, DIMENSION(:)          :: dum_var               !< value of variable read from netcdf input
+       INTEGER(iwp)                                     :: errno                 !< error number NF90_???? function
+       INTEGER(iwp)                                     :: id_var                !< variable id
+!       INTEGER(iwp)                                     :: id_emis               !< NetCDF id of input file
+       INTEGER(iwp)                                     :: num_vars              !< number of variables in netcdf input file
+       INTEGER(iwp)                                     :: len_dims,len_dims_2   !< Length of dimensions
+
+       INTEGER(iwp)                                     :: max_string_length=25  !< Variable for the maximum length of a string
+ 
+       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE    :: var_names             !< Name of Variables
+
+       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)          :: dum_var_3d            !< variable for storing temporary data of 3-dimensional 
+                                                                                 !  variables read from netcdf for chemistry emissions
+
+       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:)        :: dum_var_4d            !< variable for storing temporary data of 5-dimensional
+                                                                                 !< variables read from netcdf for chemistry emissions
+!--
+       !> Start the processing of the data
+       CALL location_message( 'starting allocation of chemistry emissions arrays', .FALSE. )
+
+       !> Parameterized mode of the emissions
+       IF (TRIM(mode_emis)=="PARAMETERIZED" .OR. TRIM(mode_emis)=="parameterized") THEN 
+
+           ispec=1
+           emt_att%nspec=0
+
+          !number of species
+           DO  WHILE (TRIM( surface_csflux_name( ispec ) ) /= 'novalue' )
+
+             emt_att%nspec=emt_att%nspec+1
+             ispec=ispec+1
+
+           ENDDO
+
+          !-- allocate emission values data type arrays
+          ALLOCATE(emt(emt_att%nspec))
+
+          !-- Read EMISSION SPECIES NAMES
+
+          !Assign values
+          ALLOCATE(emt_att%species_name(emt_att%nspec))
+ 
+         DO ispec=1,emt_att%nspec
+            emt_att%species_name(ispec) = TRIM(surface_csflux_name(ispec))
+         ENDDO
+
+          !Assign Constant Values of time factors:
+          emt_att%par_emis_time_factor( : ) = (/ 0.01, 0.01, 0.01, 0.02, 0.03, 0.07, 0.09, 0.09, 0.05, 0.03, 0.03, 0.03, &
+                                                 0.03, 0.03, 0.03, 0.04, 0.05, 0.09, 0.09, 0.09, 0.04, 0.02, 0.01, 0.01 /)
+
+       !> DEFAULT AND PRE-PROCESSED MODE
+       ELSE
+
+#if defined ( __netcdf )        
+          IF ( .NOT. input_pids_chem )  RETURN
+
+          !-- Open file in read-only mode
+          CALL open_read_file( TRIM( input_file_chem ) //                       &
+                               TRIM( coupling_char ), id_emis )
+          !-- inquire number of variables
+          CALL inquire_num_variables( id_emis, num_vars )
+
+          !-- Get General Dimension Lengths: only number of species and number of categories.
+          !                                  the other dimensions depend on the mode of the emissions or on the presence of specific components
+          !nspecies
+          CALL get_dimension_length( id_emis, emt_att%nspec, 'nspecies' )
+
+ 
+          !-- Allocate emission values data type arrays
+          ALLOCATE(emt(1:emt_att%nspec))
+
+
+          !-- Read EMISSION SPECIES NAMES
+          !Allocate Arrays 
+          ALLOCATE(emt_att%species_name(emt_att%nspec)) 
+
+          !Call get Variable
+          CALL get_variable( id_emis, 'emission_name', string_values, emt_att%nspec )
+          emt_att%species_name=string_values
+          ! If allocated, Deallocate var_string, an array only used for reading-in strings
+          IF (ALLOCATED(string_values)) DEALLOCATE(string_values) 
+
+          !-- Read EMISSION SPECIES INDEX
+          !Allocate Arrays 
+          ALLOCATE(emt_att%species_index(emt_att%nspec))
+          !Call get Variable
+          CALL get_variable( id_emis, 'emission_index', emt_att%species_index )
+
+
+          !-- Now the routine has to distinguish between DEFAULT and PRE-PROCESSED chemistry emission modes
+
+          IF (TRIM(mode_emis)=="DEFAULT" .OR. TRIM(mode_emis)=="default") THEN
+ 
+             !number of categories
+             CALL get_dimension_length( id_emis, emt_att%ncat, 'ncat' )
+
+             !-- Read EMISSION CATEGORIES INDEX
+             !Allocate Arrays 
+             ALLOCATE(emt_att%cat_index(emt_att%ncat))
+             !Call get Variable
+             CALL get_variable( id_emis, 'emission_cat_index', emt_att%cat_index )
+
+ 
+             DO ispec=1,emt_att%nspec
+                !-- EMISSION_VOC_NAME (1-DIMENSIONAL)
+                IF (TRIM(emt_att%species_name(ispec))=="VOC" .OR. TRIM(emt_att%species_name(ispec))=="voc") THEN
+                   !Allocate Array
+                   CALL get_dimension_length( id_emis, emt_att%nvoc, 'nvoc' )
+                   ALLOCATE(emt_att%voc_name(1:emt_att%nvoc))
+                   !Read-in Variable
+                   CALL get_variable( id_emis,"emission_voc_name",string_values, emt_att%nvoc)
+                   emt_att%voc_name=string_values
+                   IF (ALLOCATED(string_values)) DEALLOCATE(string_values)
+ 
+                !-- COMPOSITION VOC (2-DIMENSIONAL)
+                   !Allocate Array 
+                   ALLOCATE(emt_att%voc_comp(1:emt_att%ncat,1:emt_att%nvoc))
+                   !Read-in Variable
+!               CALL get_variable(id_emis,"composition_voc",emt%voc_comp,1,1,emt%ncat,emt%nvoc)
+                   CALL get_variable(id_emis,"composition_voc",emt_att%voc_comp,1,emt_att%ncat,1,emt_att%nvoc)
+                ENDIF
+
+                !-- EMISSION_PM_NAME (1-DIMENSIONAL)
+                IF (TRIM(emt_att%species_name(ispec))=="PM" .OR. TRIM(emt_att%species_name(ispec))=="pm") THEN
+                   CALL get_dimension_length( id_emis, emt_att%npm, 'npm' )
+                   ALLOCATE(emt_att%pm_name(1:emt_att%npm))
+                   !Read-in Variable
+                   CALL get_variable( id_emis,"pm_name",string_values, emt_att%npm)
+                   emt_att%pm_name=string_values
+                   IF (ALLOCATED(string_values)) DEALLOCATE(string_values)      
+
+                !-- COMPOSITION PM (3-DIMENSIONAL)
+                   !Allocate
+                   len_dims=3  !> number of PMs: PM1, PM2.5 and PM10
+                   ALLOCATE(emt_att%pm_comp(1:emt_att%ncat,1:emt_att%npm,1:len_dims))
+                   !Read-in Variable
+                   CALL get_variable(id_emis,"composition_pm",emt_att%pm_comp,1,emt_att%ncat,1,emt_att%npm,1,len_dims)                    
+                ENDIF
+
+                !-- COMPOSITION_NOX (2-DIMENSIONAL)
+                IF (TRIM(emt_att%species_name(ispec))=="NOx" .OR. TRIM(emt_att%species_name(ispec))=="nox") THEN
+                   !Allocate array
+                   ALLOCATE(emt_att%nox_comp(1:emt_att%ncat,1:emt_att%nnox))
+                   !Read-in Variable
+                   CALL get_variable(id_emis,"composition_nox",emt_att%nox_comp,1,emt_att%ncat,1,emt_att%nnox)
+                ENDIF
+
+                !-- COMPOSITION-SOX (2-DIMENSIONAL)
+                IF (TRIM(emt_att%species_name(ispec))=="SOx" .OR. TRIM(emt_att%species_name(ispec))=="sox") THEN
+                   ALLOCATE(emt_att%sox_comp(1:emt_att%ncat,1:emt_att%nsox))
+                   !Read-in Variable
+                   CALL get_variable(id_emis,"composition_sox",emt_att%sox_comp,1,emt_att%ncat,1,emt_att%nsox)
+                ENDIF
+             ENDDO !>ispec
+
+!-- For reading the emission time factors, the distinction between HOUR and MDH data is necessary
+      
+             !-- EMISSION_TIME_SCALING_FACTORS
+                !-- HOUR   
+             IF (TRIM(time_fac_type)=="HOUR" .OR. TRIM(time_fac_type)=="hour") THEN
+                !-- Allocate Array
+                CALL get_dimension_length( id_emis, emt_att%nhoursyear, 'nhoursyear' )
+                ALLOCATE(emt_att%hourly_emis_time_factor(1:emt_att%ncat,1:emt_att%nhoursyear))
+                !Read-in Variable
+                CALL get_variable(id_emis,"emission_time_factors",emt_att%hourly_emis_time_factor,1,emt_att%ncat,1,emt_att%nhoursyear)
+
+                !-- MDH
+             ELSE IF (TRIM(time_fac_type) == "MDH" .OR. TRIM(time_fac_type) == "mdh") THEN
+                !-- Allocate Array
+                CALL get_dimension_length( id_emis, emt_att%nmonthdayhour, 'nmonthdayhour' )
+                ALLOCATE(emt_att%mdh_emis_time_factor(1:emt_att%ncat,1:emt_att%nmonthdayhour))
+                !-- Read-in Variable
+                CALL get_variable(id_emis,"emission_time_factors",emt_att%mdh_emis_time_factor,1,emt_att%ncat,1,emt_att%nmonthdayhour)
+
+             ELSE
+
+             message_string = 'We are in the DEFAULT chemistry emissions mode: '            //          &
+                              '     !no time-factor type specified!'                        //          &
+                              'Please, specify the value of time_fac_type:'                 //          &
+                              '         either "MDH" or "HOUR"'                  
+             CALL message( 'netcdf_data_input_chemistry_data', 'CM0200', 2, 2, 0, 6, 0 ) 
+ 
+
+             ENDIF
+
+             !-- Finally read-in the emission values and their units (DEFAULT mode)
+
+             DO ispec=1,emt_att%nspec
+
+                IF ( .NOT. ALLOCATED( emt(ispec)%default_emission_data ) ) ALLOCATE(emt(ispec)%default_emission_data(1:emt_att%ncat,1:ny+1,1:nx+1))
+
+                ALLOCATE(dum_var_3d(1:emt_att%ncat,nys+1:nyn+1,nxl+1:nxr+1))
+
+                CALL get_variable(id_emis,"emission_values",dum_var_3d,ispec,1,emt_att%ncat,nys,nyn,nxl,nxr)          
+
+                emt(ispec)%default_emission_data(:,nys+1:nyn+1,nxl+1:nxr+1)=dum_var_3d(1:emt_att%ncat,nys+1:nyn+1,nxl+1:nxr+1)
+
+                DEALLOCATE (dum_var_3d)
+
+             ENDDO
+
+             !-- UNITS
+             CALL get_attribute(id_emis,"units",emt_att%units,.FALSE.,"emission_values")
+
+
+          !-- PRE-PROCESSED MODE --
+
+          ELSE IF (TRIM(mode_emis)=="PRE-PROCESSED" .OR. TRIM(mode_emis)=="pre-processed") THEN
+          !-- In the PRE-PROCESSED mode, only the VOC names, the VOC_composition, the emission values and their units remain to be read at this point
+
+             DO ispec=1,emt_att%nspec
+
+             !-- EMISSION_VOC_NAME (1-DIMENSIONAL)
+                IF (TRIM(emt_att%species_name(ispec))=="VOC" .OR. TRIM(emt_att%species_name(ispec))=="voc") THEN
+                   !Allocate Array
+                   CALL get_dimension_length( id_emis, emt_att%nvoc, 'nvoc' )
+                   ALLOCATE(emt_att%voc_name(1:emt_att%nvoc))
+                   !Read-in Variable
+                   CALL get_variable( id_emis,"emission_voc_name",string_values, emt_att%nvoc)
+                   emt_att%voc_name=string_values
+                   IF (ALLOCATED(string_values)) DEALLOCATE(string_values)
+ 
+             !-- COMPOSITION VOC (2-DIMENSIONAL)
+                   !Allocate Array 
+                   ALLOCATE(emt_att%voc_comp(1:emt_att%ncat,1:emt_att%nvoc))
+                   !Read-in Variable
+                   CALL get_variable(id_emis,"composition_voc",emt_att%voc_comp,1,emt_att%ncat,1,emt_att%nvoc)
+                ENDIF
+  
+             ENDDO !> ispec
+
+             !-- EMISSION_VALUES (4-DIMENSIONAL)
+             !Calculate temporal dimension length
+             CALL get_dimension_length( id_emis, emt_att%dt_emission, 'time' )   
+         
+
+             DO ispec=1,emt_att%nspec
+
+                !Allocation for the entire domain has to be done only for the first processor between all the subdomains     
+                IF ( .NOT. ALLOCATED( emt(ispec)%preproc_emission_data ) ) ALLOCATE(emt(ispec)%preproc_emission_data(emt_att%dt_emission,1,1:ny+1,1:nx+1)) 
+
+                !> allocate variable where to pass emission values read from netcdf
+                ALLOCATE(dum_var_4d(1:emt_att%dt_emission,1,nys+1:nyn+1,nxl+1:nxr+1))
+
+                !Read-in Variable 
+                CALL get_variable(id_emis,"emission_values",dum_var_4d,ispec,1,emt_att%dt_emission,1,1,nys,nyn,nxl,nxr)          
+
+      
+                emt(ispec)%preproc_emission_data(:,1,nys+1:nyn+1,nxl+1:nxr+1)=dum_var_4d(1:emt_att%dt_emission,1,nys+1:nyn+1,nxl+1:nxr+1)
+
+                DEALLOCATE ( dum_var_4d )
+
+             ENDDO
+
+             !-- UNITS
+             CALL get_attribute(id_emis,"units",emt_att%units,.FALSE.,"emission_values")
+       
+          ENDIF
+
+       CALL close_input_file( id_emis )
+
+#endif
+       ENDIF
+
+    END SUBROUTINE netcdf_data_input_chemistry_data
 
 !------------------------------------------------------------------------------!
@@ -4094,4 +4469,78 @@
 ! Description:
 ! ------------
+!> Routine for reading-in a character string from the chem emissions netcdf input file.  
+!------------------------------------------------------------------------------!
+ 
+ SUBROUTINE get_variable_string( id, variable_name, var_string, names_number)
+#if defined( __netcdf )
+
+    USE indices
+    USE pegrid
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=25), ALLOCATABLE, DIMENSION(:), INTENT(INOUT)  :: var_string
+
+    CHARACTER(LEN=*)                                              :: variable_name          !> variable name 
+
+    CHARACTER (LEN=1), ALLOCATABLE, DIMENSION(:,:)                :: tmp_var_string         !> variable to be read
+
+
+    INTEGER(iwp), INTENT(IN)                                      :: id                     !> file id
+
+    INTEGER(iwp), INTENT(IN)                                      :: names_number           !> number of names
+
+    INTEGER(iwp)                                                  :: id_var                 !> variable id
+
+    INTEGER(iwp)                                                  :: i,j                    !> index to go through the length of the dimensions
+
+    INTEGER(iwp)                                                  :: max_string_length=25   !> this is both the maximum length of a name, but also  
+                                                                                            ! the number of the components of the first dimensions
+                                                                                            ! (rows)
+
+
+    ALLOCATE(tmp_var_string(max_string_length,names_number))
+
+    ALLOCATE(var_string(names_number))
+
+    !-- Inquire variable id
+    nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
+
+
+    !-- Get variable
+    !-- Start cycle over the emission species
+    DO i = 1, names_number 
+       !-- read the first letter of each component
+       nc_stat = NF90_GET_VAR( id, id_var, var_string(i), start = (/ 1,i /), &
+                                 count = (/ 1,1 /) )
+       CALL handle_error( 'get_variable_string', 701 )
+
+       !-- Start cycle over charachters
+       DO j = 1, max_string_length
+                       
+          !-- read the rest of the components of the name
+          nc_stat = NF90_GET_VAR( id, id_var, tmp_var_string(j,i), start = (/ j,i /),&
+                                     count = (/ 1,1 /) )
+          CALL handle_error( 'get_variable_string', 702 )
+
+          IF ( iachar(tmp_var_string(j,i) ) == 0 ) THEN
+               tmp_var_string(j,i)=''
+          ENDIF
+
+          IF ( j>1 ) THEN
+          !-- Concatenate first letter of the name and the others
+             var_string(i)=TRIM(var_string(i)) // TRIM(tmp_var_string(j,i))
+
+          ENDIF 
+       ENDDO 
+    ENDDO
+
+#endif
+ END SUBROUTINE get_variable_string
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
 !> Reads a 1D integer variable from file.
 !------------------------------------------------------------------------------!
@@ -4233,4 +4682,26 @@
 #endif
        ENDIF
+
+
+       !Temporary solution for reading emission chemistry files: TBD: we should discuss whether remove it or not
+       IF ( id==id_emis ) THEN
+
+          !--    Allocate temporary variable according to memory access on file. 
+          ALLOCATE( tmp(is:ie,js:je) )
+
+          !--    Get variable
+          nc_stat = NF90_GET_VAR( id, id_var, tmp,                                &
+                                  start = (/ is,      js /),                  &
+                                  count = (/ ie-is+1 , je-js+1 /) ) 
+
+          var=tmp
+
+          CALL handle_error( 'get_variable_2d_real', 530, variable_name ) !TBD: the error number shuld be changed, but since the solution is 
+                                                                          ! provisory, we give the same as below
+ 
+          DEALLOCATE( tmp )
+       
+       !>  Original Subroutine part
+       ELSE
 !
 !--    Allocate temporary variable according to memory access on file. 
@@ -4238,19 +4709,20 @@
 !
 !--    Get variable
-       nc_stat = NF90_GET_VAR( id, id_var, tmp,                                &
+          nc_stat = NF90_GET_VAR( id, id_var, tmp,                                &
                                start = (/ is+1,      js+1 /),                  &
                                count = (/ ie-is + 1, je-js+1 /) )   
                                
-       CALL handle_error( 'get_variable_2d_real', 530, variable_name )
+          CALL handle_error( 'get_variable_2d_real', 530, variable_name )
 !
 !--    Resort data. Please note, dimension subscripts of var all start at 1. 
-       DO  i = is, ie 
-          DO  j = js, je 
-             var(j-js+1,i-is+1) = tmp(i,j)
+          DO  i = is, ie 
+             DO  j = js, je 
+                var(j-js+1,i-is+1) = tmp(i,j)
+             ENDDO
           ENDDO
-       ENDDO
        
-       DEALLOCATE( tmp )
-
+          DEALLOCATE( tmp )
+
+       ENDIF
 #endif
     END SUBROUTINE get_variable_2d_real
@@ -4647,4 +5119,24 @@
 #endif
        ENDIF
+
+      !Temporary solution for reading emission chemistry files: 
+       IF ( id==id_emis ) THEN
+
+          !--    Allocate temporary variable according to memory access on file. 
+          ALLOCATE( tmp(is:ie,js:je,k1s:k1e,k2s:k2e) )
+
+          !--    Get variable
+          nc_stat = NF90_GET_VAR( id, id_var, tmp,                                &
+                                  start = (/ is,   js,   k1s+1,   k2s+1 /),                  &
+                                  count = (/ ie-is+1 , je-js+1, k1e-k1s+1, k2e-k2s+1 /) ) 
+
+          var=tmp
+
+          CALL handle_error( 'get_variable_4d_real', 535, variable_name )
+ 
+          DEALLOCATE( tmp )
+
+       !> Original subroutine part
+       ELSE
 !
 !--    Allocate temporary variable according to memory access on file. 
@@ -4652,27 +5144,115 @@
 !
 !--    Get variable
-       nc_stat = NF90_GET_VAR( id, id_var, tmp,                                &
+          nc_stat = NF90_GET_VAR( id, id_var, tmp,                                &
                                start = (/ is+1,    js+1,   k1s+1, k2s+1 /),    &
                                count = (/ ie-is+1, je-js+1,                    &
                                           k1e-k1s+1, k2e-k2s+1 /) )
 
-       CALL handle_error( 'get_variable_4d_real', 535, variable_name )
+          CALL handle_error( 'get_variable_4d_real', 535, variable_name )
 !
 !--    Resort data. Please note, dimension subscripts of var all start at 1. 
-       DO  i = is, ie 
-          DO  j = js, je
-             DO  k1 = k1s, k1e
-                DO  k2 = k2s, k2e
-                   var(k2-k2s+1,k1-k1s+1,j-js+1,i-is+1) = tmp(i,j,k1,k2)
+          DO  i = is, ie 
+             DO  j = js, je
+                DO  k1 = k1s, k1e
+                   DO  k2 = k2s, k2e
+                      var(k2-k2s+1,k1-k1s+1,j-js+1,i-is+1) = tmp(i,j,k1,k2)
+                   ENDDO
                 ENDDO
              ENDDO
           ENDDO
-       ENDDO
        
-       DEALLOCATE( tmp )
+          DEALLOCATE( tmp )
+       ENDIF
 #endif
     END SUBROUTINE get_variable_4d_real
 
-
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Reads a 4D float variable from file and store it to a 3-d variable.
+!------------------------------------------------------------------------------!
+    SUBROUTINE get_variable_4d_to_3d_real( id, variable_name, var, ns, is, ie, js, je,   &
+                                           ks, ke )
+
+       USE indices
+       USE pegrid
+
+       IMPLICIT NONE
+
+       CHARACTER(LEN=*)              ::  variable_name   !< variable name
+
+       INTEGER(iwp)                  ::  ns              !< start index for subdomain input along n dimension: ns coincides here with ne, since, we select only one value along the 1st dimension n
+
+       INTEGER(iwp)                  ::  i               !< index along x direction
+       INTEGER(iwp)                  ::  ie              !< end index for subdomain input along x direction
+       INTEGER(iwp)                  ::  is              !< start index for subdomain input along x direction
+       INTEGER(iwp), INTENT(IN)      ::  id              !< file id
+       INTEGER(iwp)                  ::  id_var          !< variable id
+       INTEGER(iwp)                  ::  j               !< index along y direction
+       INTEGER(iwp)                  ::  je              !< end index for subdomain input along y direction
+       INTEGER(iwp)                  ::  js              !< start index for subdomain input along y direction
+       INTEGER(iwp)                  ::  k               !< index along any 4th dimension
+       INTEGER(iwp)                  ::  ke              !< end index of 4th dimension
+       INTEGER(iwp)                  ::  ks              !< start index of 4th dimension
+       
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   ::  tmp !< temporary variable to read data from file according 
+                                                         !< to its reverse memory access
+
+       REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) ::  var  !< variable where the read data have to be stored: one dimension is reduced in the process
+#if defined( __netcdf )
+
+!
+!--    Inquire variable id
+       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )  
+!
+!--    Check for collective read-operation and set respective NetCDF flags if
+!--    required. 
+       IF ( collective_read )  THEN
+          nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE)
+       ENDIF
+
+      !Temporary solution for reading emission chemistry files: 
+       IF ( id==id_emis ) THEN
+
+          !--    Allocate temporary variable according to memory access on file. 
+          ALLOCATE( tmp(is:ie,js:je,ks:ke) )
+
+          !--    Get variable
+          nc_stat = NF90_GET_VAR( id, id_var, tmp(is:ie,js:je,ks:ke),                                &
+                                  start = (/ ns, is,   js+1,   ks+1 /),                  &
+                                  count = (/ 1, ie-is+1 , je-js+1, ke-ks+1 /) ) 
+
+          var=tmp(:,:,:)
+
+          CALL handle_error( 'get_variable_4d_to_3d_real', 536, variable_name )
+ 
+          DEALLOCATE( tmp )
+
+       ELSE
+!
+!--    Allocate temporary variable according to memory access on file. 
+          ALLOCATE( tmp(is:ie,js:je,ks:ke) )
+!
+!--    Get variable
+          nc_stat = NF90_GET_VAR( id, id_var, tmp,                                &
+                                  start = (/ ns+1, is+1,    js+1,    ks+1 /),           &
+                                  count = (/ 1, ie-is+1, je-js+1, ke-ks+1 /) )   
+                               
+          CALL handle_error( 'get_variable_4d_to_3d_real', 536, variable_name )
+!
+!--    Resort data. Please note, dimension subscripts of var all start at 1. 
+          DO  i = is, ie 
+             DO  j = js, je
+                DO  k = ks, ke
+                   var(k-ks+1,j-js+1,i-is+1) = tmp(i,j,k)
+                ENDDO
+             ENDDO
+          ENDDO
+       
+         DEALLOCATE( tmp )
+
+       ENDIF
+#endif
+    END SUBROUTINE get_variable_4d_to_3d_real
 
 !------------------------------------------------------------------------------!
@@ -4755,5 +5335,5 @@
                                count = (/ count_1, count_2, count_3 /) )
 
-       CALL handle_error( 'get_variable_3d_real_dynamic', 536, variable_name )
+       CALL handle_error( 'get_variable_3d_real_dynamic', 537, variable_name )
 !
 !--    Resort data. Please note, dimension subscripts of var all start at 1. 
@@ -4770,4 +5350,98 @@
     END SUBROUTINE get_variable_3d_real_dynamic
 
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Reads a 5D float variable from file and store it to a 4-d variable.
+!------------------------------------------------------------------------------!
+    SUBROUTINE get_variable_5d_to_4d_real( id, variable_name, var,              &
+                                           ns, ts, te, is, ie, js, je, ks, ke )
+
+       USE indices
+       USE pegrid
+
+       IMPLICIT NONE
+
+       CHARACTER(LEN=*)              ::  variable_name   !< variable name
+
+       INTEGER(iwp)                  ::  ns              !< start index for subdomain input along n dimension: ns coincides here with ne, since, we select only one value along the 1st dimension n
+
+       INTEGER(iwp)                  ::  t               !< index along t direction
+       INTEGER(iwp)                  ::  te              !< end index for subdomain input along t direction
+       INTEGER(iwp)                  ::  ts              !< start index for subdomain input along t direction
+
+       INTEGER(iwp)                  ::  i               !< index along x direction
+       INTEGER(iwp)                  ::  ie              !< end index for subdomain input along x direction
+       INTEGER(iwp)                  ::  is              !< start index for subdomain input along x direction
+       INTEGER(iwp), INTENT(IN)      ::  id              !< file id
+       INTEGER(iwp)                  ::  id_var          !< variable id
+       INTEGER(iwp)                  ::  j               !< index along y direction
+       INTEGER(iwp)                  ::  je              !< end index for subdomain input along y direction
+       INTEGER(iwp)                  ::  js              !< start index for subdomain input along y direction
+       INTEGER(iwp)                  ::  k               !< index along any 5th dimension
+       INTEGER(iwp)                  ::  ke              !< end index of 5th dimension
+       INTEGER(iwp)                  ::  ks              !< start index of 5th dimension
+       
+       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE   ::  tmp !< temporary variable to read data from file according 
+                                                           ! to its reverse memory access
+       REAL(wp), DIMENSION(:,:,:,:), INTENT(INOUT) ::  var !< variable to be read
+#if defined( __netcdf )
+!
+!--    Inquire variable id
+       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )  
+!
+!--    Check for collective read-operation and set respective NetCDF flags if
+!--    required. 
+       IF ( collective_read )  THEN
+          nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE)
+       ENDIF
+
+      !Temporary solution for reading emission chemistry files: 
+       IF ( id==id_emis ) THEN
+
+          !--    Allocate temporary variable according to memory access on file. 
+          ALLOCATE( tmp(ts:te,1,js+1:je+1,ks+1:ke+1) )
+
+          !--    Get variable
+          nc_stat = NF90_GET_VAR( id, id_var, tmp(ts:te,1,js+1:je+1,ks+1:ke+1),               &
+                                  start = (/ ns, ts,  1,   js+1,   ks+1 /),                  &
+                                  count = (/ 1, te-ts+1, 1, je-js+1, ke-ks+1 /) ) 
+
+          var=tmp
+
+          CALL handle_error( 'get_variable_5d_to_4d_real', 538, variable_name )
+ 
+          DEALLOCATE( tmp )
+
+       !>  Original Subroutine part
+       ELSE
+!
+!--    Allocate temporary variable according to memory access on file. 
+          ALLOCATE( tmp(ks:ke,js:je,is:is,ts:te) )
+!
+!--    Get variable
+          nc_stat = NF90_GET_VAR( id, id_var, tmp,                                &
+                                  start = (/ ks+1, js+1, is+1, ts+1, ns /),           &
+                                  count = (/ ke-ks+1, je-js+1, ie-is+1, te-ts+1, 1 /) )   
+                               
+          CALL handle_error( 'get_variable_5d_to_4d_real', 538, variable_name )
+!
+!--    Resort data. Please note, dimension subscripts of var all start at 1. 
+
+          DO  t = ts, te 
+             DO  i = is, ie 
+                DO  j = js, je
+                   DO  k = ks, ke
+                      var(t-ts+1,i-is+1,j-js+1,k-ks+1) = tmp(k,j,i,t)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ENDDO 
+
+         DEALLOCATE( tmp )
+
+       ENDIF
+#endif
+    END SUBROUTINE get_variable_5d_to_4d_real
 
 
@@ -4789,5 +5463,5 @@
 
        nc_stat = NF90_INQUIRE( id, NVARIABLES = num_vars )
-       CALL handle_error( 'inquire_num_variables', 537 )
+       CALL handle_error( 'inquire_num_variables', 539 )
 
 #endif
@@ -4816,9 +5490,9 @@
        ALLOCATE( varids(1:SIZE(var_names)) )
        nc_stat = NF90_INQ_VARIDS( id, NVARS = num_vars, VARIDS = varids )
-       CALL handle_error( 'inquire_variable_names', 538 )
+       CALL handle_error( 'inquire_variable_names', 540 )
 
        DO  i = 1, SIZE(var_names)
           nc_stat = NF90_INQUIRE_VARIABLE( id, varids(i), NAME = var_names(i) )
-          CALL handle_error( 'inquire_variable_names', 538 )
+          CALL handle_error( 'inquire_variable_names', 540 )
        ENDDO
 
Index: palm/trunk/SOURCE/outflow_turbulence.f90
===================================================================
--- palm/trunk/SOURCE/outflow_turbulence.f90	(revision 3297)
+++ palm/trunk/SOURCE/outflow_turbulence.f90	(revision 3298)
@@ -24,5 +24,5 @@
 ! Former revisions:
 ! -----------------
-! $Id$
+! $Id: outflow_turbulence.f90 3241 2018-09-12 15:02:00Z raasch $
 ! unused variables removed
 ! 
Index: palm/trunk/SOURCE/palm.f90
===================================================================
--- palm/trunk/SOURCE/palm.f90	(revision 3297)
+++ palm/trunk/SOURCE/palm.f90	(revision 3298)
@@ -25,4 +25,12 @@
 ! -----------------
 ! $Id$
+! - Minor formatting (kanani)
+! - Added Call of date_and_time_init (Russo)
+! - Added Call of calc_date_and_time before call of init_3d where emissions 
+!   are initialized:
+!   we have to know the time indices to initialize emission values (Russo)
+! - Added Call of netcdf_data_input_chemistry_data (Russo)
+!
+! 3274 2018-09-24 15:42:55Z knoop
 ! Modularization of all bulk cloud physics code components
 ! 
@@ -241,9 +249,15 @@
     USE arrays_3d
 
+    USE bulk_cloud_model_mod,                                                  &
+        ONLY: bulk_cloud_model, microphysics_morrison, microphysics_seifert
+
+    USE chem_modules,                                                          &
+        ONLY:  do_emis
+
     USE chemistry_model_mod,                                                   &
-        ONLY:  chem_init
-
-    USE chem_photolysis_mod,                                                   &
-        ONLY:  photolysis_init
+        ONLY:  chem_check_data_output_pr, chem_init
+
+!    USE chem_photolysis_mod,                                                   &
+!        ONLY:  photolysis_init
 
     USE control_parameters,                                                    &
@@ -259,4 +273,7 @@
         ONLY:  cpu_log, log_point, log_point_s, cpu_statistics
 
+    USE date_and_time_mod,                                                     &
+        ONLY:  calc_date_and_time, init_date_and_time
+
     USE indices,                                                               &
         ONLY:  nbgp
@@ -264,12 +281,10 @@
     USE kinds
 
-    USE bulk_cloud_model_mod,                                                  &
-        ONLY: bulk_cloud_model, microphysics_morrison, microphysics_seifert
-
     USE multi_agent_system_mod,                                                &
         ONLY:  agents_active, mas_last_actions
 
     USE netcdf_data_input_mod,                                                 &
-        ONLY:  netcdf_data_input_inquire_file, netcdf_data_input_init,         &
+        ONLY:  chem_emis, chem_emis_att, netcdf_data_input_chemistry_data,     &
+               netcdf_data_input_inquire_file, netcdf_data_input_init,         &
                netcdf_data_input_surface_data, netcdf_data_input_topo
 
@@ -410,7 +425,15 @@
 !-- --> Needs to be moved!! What is the dependency about?
 ! IF (  TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
-    IF ( air_chemistry )  THEN
+    IF ( air_chemistry  .AND.  do_emis )  THEN
+
+       IF ( do_emis ) THEN
+          CALL netcdf_data_input_chemistry_data(chem_emis_att,chem_emis)
+       ENDIF
+
        CALL chem_init
-       CALL photolysis_init   ! probably also required for restart
+!       CALL photolysis_init   ! probably also required for restart
+
+       CALL init_date_and_time     !initialize the time of chemistry emissions
+
     ENDIF
 ! END IF
@@ -421,4 +444,6 @@
 !
 !-- Initialize all necessary variables
+    CALL calc_date_and_time !this is required for chemistry emissions
+
     CALL init_3d_model
 
Index: palm/trunk/SOURCE/parin.f90
===================================================================
--- palm/trunk/SOURCE/parin.f90	(revision 3297)
+++ palm/trunk/SOURCE/parin.f90	(revision 3298)
@@ -25,4 +25,8 @@
 ! -----------------
 ! $Id$
+! Introduced reading of date_init to inipar.(Russo)
+! Add extra profiles for chemistry (basit)
+!
+! 3294 2018-10-01 02:37:10Z raasch
 ! changes concerning modularization of ocean option
 ! 
@@ -421,4 +425,6 @@
 ! ------------
 !> This subroutine reads variables controling the run from the NAMELIST files
+!>
+!> @todo: Revise max_pr_cs (profiles for chemistry)
 !------------------------------------------------------------------------------!
  SUBROUTINE parin
@@ -443,5 +449,5 @@
 
     USE date_and_time_mod,                                                     &
-        ONLY:  day_of_year_init, time_utc_init
+        ONLY:  date_init, day_of_year_init, time_utc_init
 
     USE dvrp_variables,                                                        &
@@ -548,4 +554,5 @@
              cycle_mg, damp_level_1d,                                          &
              data_output_during_spinup,                                        &
+             date_init,                                                        &
              day_of_year_init,                                                 &
              dissipation_1d,                                                   &
@@ -620,4 +627,5 @@
              cycle_mg, damp_level_1d,                                          &
              data_output_during_spinup,                                        &
+             date_init,                                                        &
              day_of_year_init,                                                 &
              dissipation_1d,                                                   &
@@ -1066,6 +1074,6 @@
                        ref_state(0:nz+1), sa_init(0:nz+1), ug(0:nz+1),         &
                        u_init(0:nz+1), v_init(0:nz+1), vg(0:nz+1),             &
-                       hom(0:nz+1,2,pr_palm+max_pr_user,0:statistic_regions),  &
-                       hom_sum(0:nz+1,pr_palm+max_pr_user,0:statistic_regions) )
+                       hom(0:nz+1,2,pr_palm+max_pr_user+max_pr_cs,0:statistic_regions),  &
+                       hom_sum(0:nz+1,pr_palm+max_pr_user+max_pr_cs,0:statistic_regions) )
 
              hom = 0.0_wp
Index: palm/trunk/SOURCE/prognostic_equations.f90
===================================================================
--- palm/trunk/SOURCE/prognostic_equations.f90	(revision 3297)
+++ palm/trunk/SOURCE/prognostic_equations.f90	(revision 3298)
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! Code added for decycling chemistry (basit)
+!
+! 3294 2018-10-01 02:37:10Z raasch
 ! changes concerning modularization of ocean option
 ! 
@@ -335,6 +338,6 @@
 
     USE chemistry_model_mod,                                                   &
-        ONLY:  chem_integrate, chem_prognostic_equations,                      &
-               chem_species, nspec, nvar, spc_names
+        ONLY:  chem_integrate, chem_species,  chem_prognostic_equations,       &
+               nspec, nvar, spc_names, chem_boundary_conds
            
     USE chem_modules,                                                          &
@@ -343,4 +346,7 @@
     USE chem_photolysis_mod,                                                   &
         ONLY:  photolysis_control
+
+    USE chem_modules,                                                          &
+        ONLY:  call_chem_at_all_substeps, chem_gasphase_on, cs_name
 
     USE control_parameters,                                                    &
@@ -456,5 +462,7 @@
 
     LOGICAL      ::  loop_start          !<
-    INTEGER      ::  n, lsp              !< lsp running index for chem spcs
+    INTEGER(iwp) ::  n
+    INTEGER(iwp) :: lsp
+    INTEGER(iwp) :: lsp_usr              !< lsp running index for chem spcs
 
 
@@ -468,4 +476,5 @@
 !-- concentrations of chemical species                                    
     IF ( air_chemistry )  THEN
+       lsp_usr = 1
 !
 !--    If required, calculate photolysis frequencies - 
@@ -492,6 +501,17 @@
 !--    Loop over chemical species       
        CALL cpu_log( log_point_s(84), 'chemistry exch-horiz ', 'start' )
-       DO  n = 1, nspec
-          CALL exchange_horiz( chem_species(n)%conc, nbgp )     
+       DO  lsp = 1, nspec
+          CALL exchange_horiz( chem_species(lsp)%conc, nbgp )    
+          lsp_usr = 1  
+          DO WHILE ( TRIM( cs_name( lsp_usr ) ) /= 'novalue' )
+             IF ( TRIM(chem_species(lsp)%name) == TRIM(cs_name(lsp_usr)) )  THEN
+
+                CALL chem_boundary_conds( chem_species(lsp)%conc_p,                                 &
+                                          chem_species(lsp)%conc_pr_init ) 
+             
+             ENDIF
+             lsp_usr = lsp_usr +1
+          ENDDO
+         
        ENDDO
        CALL cpu_log( log_point_s(84), 'chemistry exch-horiz ', 'stop' )
Index: palm/trunk/SOURCE/read_restart_data_mod.f90
===================================================================
--- palm/trunk/SOURCE/read_restart_data_mod.f90	(revision 3297)
+++ palm/trunk/SOURCE/read_restart_data_mod.f90	(revision 3298)
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! Added chemistry profiles for restart run (basit)
+! 
+! 3294 2018-10-01 02:37:10Z raasch
 ! changes concerning modularization of ocean option
 ! 
@@ -75,4 +78,6 @@
 ! ------------
 !> Reads restart data from restart-file(s) (binary format).
+!>
+!> @todo: Revise max_pr_cs (profiles for chemistry)
 !------------------------------------------------------------------------------!
  MODULE read_restart_data_mod
@@ -80,4 +85,8 @@
 
     USE control_parameters
+
+    USE chem_modules,                                                                              &
+       ONLY: max_pr_cs
+
 
     IMPLICIT NONE
@@ -266,6 +275,6 @@
                     v_init(0:nz+1), pt_init(0:nz+1), q_init(0:nz+1),           &
                     ref_state(0:nz+1), s_init(0:nz+1), sa_init(0:nz+1),        &
-                    hom(0:nz+1,2,pr_palm+max_pr_user,0:statistic_regions),     &
-                    hom_sum(0:nz+1,pr_palm+max_pr_user,0:statistic_regions) )
+                    hom(0:nz+1,2,pr_palm+max_pr_user+max_pr_cs,0:statistic_regions),     &
+                    hom_sum(0:nz+1,pr_palm+max_pr_user+max_pr_cs,0:statistic_regions) )
        ENDIF
 
Index: palm/trunk/SOURCE/surface_mod.f90
===================================================================
--- palm/trunk/SOURCE/surface_mod.f90	(revision 3297)
+++ palm/trunk/SOURCE/surface_mod.f90	(revision 3298)
@@ -26,4 +26,16 @@
 ! -----------------
 ! $Id$
+! - Minor formatting/clean-up (kanani)
+! - Removed initialization of cssws with surface_csflux values. Only the value 0 
+!   is now passed to all the chemical species of the selected mechanism. 
+!   The real inizialization is conducted in init_3d_model_mod.f90 (Russo)
+! - Added calls and variables for inizialization of chemistry emission 
+!   fluxes (Russo)
+! - Setting of cssws to zero moved (forkel)
+! - Set cssws to zero before setting values (forkel)
+! - Distinguish flux conversion factors for gases and PM (forkel)
+! - Some questions/todo's on conversion factors (forkel)
+!
+! 3294 2018-10-01 02:37:10Z raasch
 ! changes concerning modularization of ocean option
 ! 
@@ -2071,4 +2083,5 @@
 
              TYPE( surf_type ) :: surf          !< respective surface type
+
 !
 !--          Store indices of respective surface element
@@ -2173,5 +2186,9 @@
 
              DO  lsp = 1, nvar
-                IF ( air_chemistry )  surf%css(lsp,num_h) = 0.0_wp
+                IF ( air_chemistry )  surf%css(lsp,num_h)   = 0.0_wp
+!
+!--             Ensure that fluxes of compounds which are not specified in 
+!--             namelist are all zero --> kanani: revise
+                IF ( air_chemistry )  surf%cssws(lsp,num_h) = 0.0_wp
              ENDDO
 !
@@ -2220,5 +2237,5 @@
                    ELSE
                       surf%qsws(num_h) = wall_humidityflux(5) *                &
-                                             heatflux_input_conversion(k)
+                                                waterflux_input_conversion(k)
                    ENDIF
                 ENDIF
@@ -2227,5 +2244,5 @@
                    IF ( upward_facing )  THEN
                       IF ( constant_scalarflux )  THEN
-                         surf%ssws(num_h) = surface_scalarflux * rho_air_zw(k-1)
+                         surf%ssws(num_h) = surface_scalarflux  * rho_air_zw(k-1)
 
                          IF ( k-1 /= 0 )                                       &
@@ -3386,4 +3403,5 @@
                                   nxr_on_file, nynf, nync, nyn_on_file, nysf,  &
                                   nysc, nys_on_file, found )
+
 
        IMPLICIT NONE
Index: palm/trunk/SOURCE/time_integration.f90
===================================================================
--- palm/trunk/SOURCE/time_integration.f90	(revision 3297)
+++ palm/trunk/SOURCE/time_integration.f90	(revision 3298)
@@ -25,4 +25,9 @@
 ! -----------------
 ! $Id$
+! - Formatting, clean-up, comments (kanani)
+! - Added CALL to chem_emissions_setup (Russo)
+! - Code added for decycling chemistry (basit)
+! 
+! 3294 2018-10-01 02:37:10Z raasch
 ! changes concerning modularization of ocean option
 ! 
@@ -380,9 +385,13 @@
         ONLY:  calc_mean_profile
 
+    USE chem_emissions_mod,                                                    &
+        ONLY:  chem_emissions_setup
+
+    USE chem_modules,                                                          &
+        ONLY:  bc_cs_t_val, call_chem_at_all_substeps, cs_name,                &
+               constant_csflux, do_emis, nspec, nspec_out
+
     USE chemistry_model_mod,                                                   &
-        ONLY:  chem_emissions, chem_species
-
-    USE chem_modules,                                                          &
-        ONLY:  nspec 
+        ONLY:  chem_boundary_conds, chem_species
 
     USE control_parameters,                                                    &
@@ -426,4 +435,7 @@
         ONLY:  cpu_log, log_point, log_point_s
 
+    USE date_and_time_mod,                                                     &
+        ONLY:  calc_date_and_time, hour_call_emis, hour_of_year
+
     USE flight_mod,                                                            &
         ONLY:  flight_measurement
@@ -450,9 +462,9 @@
                lsf_nesting_offline, lsf_nesting_offline_mass_conservation
 
-    USE netcdf_data_input_mod,                                                 &
-        ONLY:  nest_offl, netcdf_data_input_lsf
-
     USE multi_agent_system_mod,                                                &
         ONLY:  agents_active, multi_agent_system
+
+    USE netcdf_data_input_mod,                                                 &
+        ONLY:  chem_emis, chem_emis_att, nest_offl, netcdf_data_input_lsf
 
     USE ocean_mod,                                                             &
@@ -525,7 +537,9 @@
     IMPLICIT NONE
 
-    CHARACTER (LEN=9) ::  time_to_string          !< 
-
-    INTEGER(iwp)      ::  n  !< loop counter for chemistry species
+    CHARACTER (LEN=9) ::  time_to_string   !<
+
+    INTEGER(iwp)      ::  lsp       !<
+    INTEGER(iwp)      ::  lsp_usr   !<
+    INTEGER(iwp)      ::  n         !< loop counter for chemistry species
 
     REAL(wp) ::  dt_3d_old  !< temporary storage of timestep to be used for
@@ -611,4 +625,11 @@
            bc_pt_t_val = ( pt_init(nzt+1) - pt_init(nzt) ) / dzu(nzt+1)
            bc_q_t_val  = ( q_init(nzt+1) - q_init(nzt) ) / dzu(nzt+1)
+           IF ( air_chemistry )  THEN
+              DO  lsp = 1, nspec
+                 bc_cs_t_val = (  chem_species(lsp)%conc_pr_init(nzt+1)       &
+                                - chem_species(lsp)%conc_pr_init(nzt) )       &
+                               / dzu(nzt+1)
+              ENDDO
+           ENDIF
        ENDIF
 !
@@ -783,6 +804,16 @@
           IF ( passive_scalar )  CALL exchange_horiz( s_p, nbgp )
           IF ( air_chemistry )  THEN
-             DO  n = 1, nspec     
-                CALL exchange_horiz( chem_species(n)%conc_p, nbgp ) 
+             DO  lsp = 1, nspec
+                CALL exchange_horiz( chem_species(lsp)%conc_p, nbgp )
+!
+!--             kanani: Push chem_boundary_conds after CALL boundary_conds
+                lsp_usr = 1
+                DO WHILE ( TRIM( cs_name( lsp_usr ) ) /= 'novalue' )
+                   IF ( TRIM(chem_species(lsp)%name) == TRIM(cs_name(lsp_usr)) )  THEN
+                      CALL chem_boundary_conds( chem_species(lsp)%conc_p,              &
+                                                chem_species(lsp)%conc_pr_init )
+                   ENDIF
+                   lsp_usr = lsp_usr + 1
+                ENDDO
              ENDDO
           ENDIF
@@ -1122,9 +1153,14 @@
 !
 !--    If required, consider chemical emissions
-!--    (todo (FK): Implement hourly call of emissions, using time_utc from
-!--                data_and_time_mod.f90;
-!--                move the CALL to appropriate location)
-       IF ( air_chemistry ) THEN
-          CALL chem_emissions
+       IF ( air_chemistry  .AND.  do_emis )  THEN
+!
+!--       Update the time --> kanani: revise location of this CALL
+          CALL calc_date_and_time
+!
+!--       Call emission routine only once an hour
+          IF (hour_of_year  .GT.  hour_call_emis )  THEN
+             CALL chem_emissions_setup( chem_emis_att, chem_emis, nspec_out )
+             hour_call_emis = hour_of_year
+          ENDIF
        ENDIF
 !
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/kpp/src/lex.yy.c
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/kpp/src/lex.yy.c	(revision 3297)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/kpp/src/lex.yy.c	(revision 3298)
@@ -10,5 +10,5 @@
 #define YY_FLEX_MAJOR_VERSION 2
 #define YY_FLEX_MINOR_VERSION 5
-#define YY_FLEX_SUBMINOR_VERSION 37
+#define YY_FLEX_SUBMINOR_VERSION 35
 #if YY_FLEX_SUBMINOR_VERSION > 0
 #define FLEX_BETA
@@ -143,5 +143,13 @@
 /* Size of default input buffer. */
 #ifndef YY_BUF_SIZE
+#ifdef __ia64__
+/* On IA-64, the buffer size is 16k, not 8k.
+ * Moreover, YY_BUF_SIZE is 2*YY_READ_BUF_SIZE in the general case.
+ * Ditto for the __ia64__ case accordingly.
+ */
+#define YY_BUF_SIZE 32768
+#else
 #define YY_BUF_SIZE 16384
+#endif /* __ia64__ */
 #endif
 
@@ -155,10 +163,5 @@
 #endif
 
-#ifndef YY_TYPEDEF_YY_SIZE_T
-#define YY_TYPEDEF_YY_SIZE_T
-typedef size_t yy_size_t;
-#endif
-
-extern yy_size_t yyleng;
+extern int yyleng;
 
 extern FILE *yyin, *yyout;
@@ -186,4 +189,9 @@
 #define unput(c) yyunput( c, (yytext_ptr)  )
 
+#ifndef YY_TYPEDEF_YY_SIZE_T
+#define YY_TYPEDEF_YY_SIZE_T
+typedef size_t yy_size_t;
+#endif
+
 #ifndef YY_STRUCT_YY_BUFFER_STATE
 #define YY_STRUCT_YY_BUFFER_STATE
@@ -203,5 +211,5 @@
 	 * characters.
 	 */
-	yy_size_t yy_n_chars;
+	int yy_n_chars;
 
 	/* Whether we "own" the buffer - i.e., we know we created it,
@@ -273,6 +281,6 @@
 /* yy_hold_char holds the character lost when yytext is formed. */
 static char yy_hold_char;
-static yy_size_t yy_n_chars;		/* number of characters read into yy_ch_buf */
-yy_size_t yyleng;
+static int yy_n_chars;		/* number of characters read into yy_ch_buf */
+int yyleng;
 
 /* Points to current character in buffer. */
@@ -302,5 +310,5 @@
 YY_BUFFER_STATE yy_scan_buffer (char *base,yy_size_t size  );
 YY_BUFFER_STATE yy_scan_string (yyconst char *yy_str  );
-YY_BUFFER_STATE yy_scan_bytes (yyconst char *bytes,yy_size_t len  );
+YY_BUFFER_STATE yy_scan_bytes (yyconst char *bytes,int len  );
 
 void *yyalloc (yy_size_t  );
@@ -801,5 +809,5 @@
           return (x); \
         }
-#line 804 "lex.yy.c"
+#line 812 "lex.yy.c"
 
 #define INITIAL 0
@@ -864,5 +872,5 @@
 void yyset_out  (FILE * out_str  );
 
-yy_size_t yyget_leng (void );
+int yyget_leng (void );
 
 char *yyget_text (void );
@@ -906,5 +914,10 @@
 /* Amount of stuff to slurp up with each read. */
 #ifndef YY_READ_BUF_SIZE
+#ifdef __ia64__
+/* On IA-64, the buffer size is 16k, not 8k */
+#define YY_READ_BUF_SIZE 16384
+#else
 #define YY_READ_BUF_SIZE 8192
+#endif /* __ia64__ */
 #endif
 
@@ -1009,5 +1022,5 @@
 #line 120 "scan.l"
 
-#line 1012 "lex.yy.c"
+#line 1025 "lex.yy.c"
 
 	if ( !(yy_init) )
@@ -1526,5 +1539,5 @@
 ECHO;
 	YY_BREAK
-#line 1529 "lex.yy.c"
+#line 1542 "lex.yy.c"
 
 	case YY_END_OF_BUFFER:
@@ -1710,5 +1723,5 @@
 	else
 		{
-			yy_size_t num_to_read =
+			int num_to_read =
 			YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1;
 
@@ -1717,5 +1730,5 @@
 
 			/* just a shorter name for the current buffer */
-			YY_BUFFER_STATE b = YY_CURRENT_BUFFER_LVALUE;
+			YY_BUFFER_STATE b = YY_CURRENT_BUFFER;
 
 			int yy_c_buf_p_offset =
@@ -1724,5 +1737,5 @@
 			if ( b->yy_is_our_buffer )
 				{
-				yy_size_t new_size = b->yy_buf_size * 2;
+				int new_size = b->yy_buf_size * 2;
 
 				if ( new_size <= 0 )
@@ -1755,5 +1768,5 @@
 		/* Read in more data. */
 		YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]),
-			(yy_n_chars), num_to_read );
+			(yy_n_chars), (size_t) num_to_read );
 
 		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
@@ -1850,5 +1863,5 @@
 	yy_is_jam = (yy_current_state == 198);
 
-		return yy_is_jam ? 0 : yy_current_state;
+	return yy_is_jam ? 0 : yy_current_state;
 }
 
@@ -1865,5 +1878,5 @@
 		{ /* need to shift things up to make room */
 		/* +2 for EOB chars. */
-		register yy_size_t number_to_move = (yy_n_chars) + 2;
+		register int number_to_move = (yy_n_chars) + 2;
 		register char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[
 					YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2];
@@ -1914,5 +1927,5 @@
 		else
 			{ /* need more input */
-			yy_size_t offset = (yy_c_buf_p) - (yytext_ptr);
+			int offset = (yy_c_buf_p) - (yytext_ptr);
 			++(yy_c_buf_p);
 
@@ -2074,4 +2087,8 @@
 }
 
+#ifndef __cplusplus
+extern int isatty (int );
+#endif /* __cplusplus */
+    
 /* Initializes or reinitializes a buffer.
  * This function is sometimes called more than once on the same buffer,
@@ -2186,5 +2203,5 @@
 static void yyensure_buffer_stack (void)
 {
-	yy_size_t num_to_alloc;
+	int num_to_alloc;
     
 	if (!(yy_buffer_stack)) {
@@ -2283,5 +2300,5 @@
  * @return the newly allocated buffer state object.
  */
-YY_BUFFER_STATE yy_scan_bytes  (yyconst char * yybytes, yy_size_t  _yybytes_len )
+YY_BUFFER_STATE yy_scan_bytes  (yyconst char * yybytes, int  _yybytes_len )
 {
 	YY_BUFFER_STATE b;
@@ -2370,5 +2387,5 @@
  * 
  */
-yy_size_t yyget_leng  (void)
+int yyget_leng  (void)
 {
         return yyleng;
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/bin/kpp4palm.ksh
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/bin/kpp4palm.ksh	(revision 3297)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/bin/kpp4palm.ksh	(revision 3298)
@@ -21,4 +21,15 @@
 # Copyright 2017-2018  Leibniz Universitaet Hannover
 #------------------------------------------------------------------------------#
+# Nov. 2016: Initial Version of KPP chemistry convertor adapted for PALM 
+# by Klaus Ketelsen
+#
+# This code is a modified version of KP4 (JÃ¶ckel, P., Kerkweg, A., Pozzer, A., 
+# Sander, R., Tost, H., Riede, H., Baumgaertner, A., Gromov, S., and Kern, B.,
+# 2010: Development cycle 2 of the Modular Earth Submodel System (MESSy2), 
+# Geosci. Model Dev., 3, 717-752, https://doi.org/10.5194/gmd-3-717-2010).
+# KP4 is part of the Modular Earth Submodel System (MESSy), which is is
+# available under the  GNU General Public License (GPL).
+#
+#------------------------------------------------------------------------------#
 #
 # Current revisions:
@@ -29,7 +40,28 @@
 # -----------------
 # $Id$ 
+# forkel   25. September 2018: Added cat for $MECH to pass mechanism name to kpp4palm
+# ketelsen 18. September 2018: Added cat for '#INLINE F90_GLOBAL' 
+# (moved here from mechanisms/def_MECH/chem_gasphase.kpp
+#
+# forkel: 14. September  2018: WCOPY removed
+# ketelsen: July 2018: Adaptations for vektor mode
+# forkel June 2018: re-established original case of subroutine names
+# forkel May 2018: additional copying of chem_gasphase_mod.f90 into $DEFDIR
+# forkel 20.04.2018: removed  wlamch and wlamch_add from $KPP_SUBROUTINE_LIST
+#                    (epsilon(one) is used now)
+# forkel March 2017
+# Re-introduced relative path for KPP_HOME
+# Subroutine list adapted to lowercase subroutine names
+# Added arr2, removed update_sun and k_3rd from subroutine list
+# Renamed output file to chem_gasphase_mod
+# Renamed this file from kp4/ksh to kpp4kpp.ksh
+# changed location of def_mechanism directories to gasphase_preproc/mechanisms
+# 
+# 
+# 2718 2018-01-02 08:49:38Z maronga
 # Initial revision
 # 
 # 
+##########################################################################
 #
 #
@@ -63,4 +95,5 @@
 # Default
 
+MECH=smog
 OUTDIR=`pwd`/../../../SOURCE
 OUTFILE=chem_gasphase_mod
@@ -70,6 +103,7 @@
 VLEN=1
 KEEP="NO"
-DE_INDEX="NO"
-DE_INDEX_FAST="NO"
+UPDT="NO"
+DE_INDEX=0
+DE_INDEX_FAST="YES"
 
 export KPP_SOLVER=Rosenbrock
@@ -77,10 +111,9 @@
 # get Command line option
 
-echo xxxxxxxxxx
-while  getopts :d:ifkp:o:s:v:w:  c     # get options
+while  getopts :m:i:fkup:o:s:vl:w:  c     # get options
 do case $c in
-      d)   DEFDIR=$OPTARG;;          # directory of definition files
-
-      i)   DE_INDEX="YES";;          # if set, deindexing
+      m)   MECH=$OPTARG;;            # mechanism
+
+      i)   DE_INDEX=$OPTARG;;        # if set, deindexing
 
       f)   DE_INDEX_FAST="YES";;     # if set, fast deindexing
@@ -92,13 +125,16 @@
       p)   PREFIX=$OPTARG;;          # Name Prefix
 
-      s)   KPP_SOLVER=$OPTARG;;      # Name Prefix
-
-      v)   MODE="vector"
-           VLEN=$OPTARG;;            # Set to vector Mode
+      s)   KPP_SOLVER=$OPTARG;;      # Update sample f90 code in the def_MECH directory
+
+      u)   UPDT="YES";;              # keep Working directory
+
+      v)   MODE="vector";;           # Set to vector Mode
+
+      l)   VLEN=$OPTARG;;            # Set vector length
 
       w)   WORK=$OPTARG;;            # Working directory
 
       \?)  print ${0##*/} "unknown option:" $OPTARG
-           print "USAGE: ${0##*/} [ -d dir -e -k -o dir -p name -s solver -v length -w dir ] "
+           print "USAGE: ${0##*/} [ -m dir -e -k -u -o dir -p name -s solver -v -l length -w dir ] "
            exit 1;;
    esac
@@ -106,7 +142,14 @@
 shift OPTIND-1
 
-echo $DEFDIR
+echo MECHANISM = $MECH
+echo DE_INDEX = $DE_INDEX
+echo KEEP = $KEEP
+echo UPDT = $UPDT
+echo MODE = $MODE
+echo VLEN = $VLEN
 
 DEF_PREFIX=${PREFIX}.kpp
+DEFDIR=`pwd`/mechanisms/def_$MECH
+echo DEFDIR = $DEFDIR
 
 # Create or clean working directory
@@ -122,9 +165,9 @@
 
 
-KPP_SUBROUTINE_LIST="initialize"
-KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST integrate fun"
-KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST kppsolve kppdecomp wlamch wlamch_add"
-KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST jac_sp k_arr "
-KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST update_rconst arr2"
+KPP_SUBROUTINE_LIST="Initialize"
+KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST INTEGRATE Fun"
+KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST KppSolve KppDecomp"
+KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST Jac_SP k_arr "
+KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST Update_RCONST ARR2"
 KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST initialize_kpp_ctrl error_output"
 
@@ -149,5 +192,9 @@
 
 # Interface ignore list
-KPP_INTERFACE_IGNORE="waxpy wcopy"
+KPP_INTERFACE_IGNORE=" "
+
+echo " "
+echo KPP_SOLVER $KPP_SOLVER
+echo " "
 
 case $KPP_SOLVER in
@@ -155,9 +202,12 @@
 
     Rosenbrock)   
-      KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST wcopy wscal waxpy"
-    if [[ $MODE != "vector" ]]
-    then
-      KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST rosenbrock  funtemplate jactemplate"
-    fi;;
+      KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST WSCAL WAXPY"
+      if [[ $MODE != "vector" ]]
+      then
+         KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST Rosenbrock  FunTemplate JacTemplate"
+        KPP_INTERFACE_IGNORE="WAXPY"
+      else 
+        KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST FunTemplate JacTemplate"
+      fi;;
 
     rosenbrock_mz)
@@ -167,5 +217,5 @@
     rosenbrock)
       KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST WCOPY WSCAL WAXPY"
-      KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST rosenbrock  funtemplate jactemplate";;
+      KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST Rosenbrock  FunTemplate JacTemplate";;
 
     kpp_lsode)
@@ -203,4 +253,23 @@
 cp $DEFDIR/${PREFIX}.kpp     .
 
+# Global variable are defined here 
+# This has the advantage that it is not necessary to include these variables in all .kpp definition files
+
+cat  >> ${PREFIX}.kpp  <<  EOF
+#INLINE F90_GLOBAL
+! QVAP - Water vapor
+  REAL(kind=dp) :: QVAP
+! FAKT - Conversion factor
+  REAL(kind=dp) :: FAKT
+
+#ENDINLINE
+EOF
+
+# Store mechanism name in file mech_list
+cat  >> mech_list  <<  EOF
+!   Mechanism: $MECH
+!
+EOF
+
 # Run kpp
 
@@ -240,6 +309,14 @@
 done
 
+echo start kp4.exe with arguments
+echo $PREFIX $MODE $VLEN $DE_INDEX $DE_INDEX_FAST
+
 $BASE/bin/kpp4palm.exe $PREFIX $MODE $VLEN $DE_INDEX $DE_INDEX_FAST
 
+#Prelimanary, substitution has to be moved into kpp4palm.exe
+if [[ $MODE = "vector" ]]
+then
+  sed -i -e 's/phot(nphot/phot(vl_dim,nphot/g' kk_kpp.f90
+fi
 
 if [[ -e $OUTDIR/${OUTFILE}.f90 ]] 
@@ -248,8 +325,13 @@
 fi
 cp -p kk_kpp.f90    $OUTDIR/${OUTFILE}.f90
-#cp -p kk_kpp.f90    $MY_PWD/../SOURCE/${OUTFILE}.f90
-
 echo " "
 echo "Write kpp module -- > " $OUTDIR/${OUTFILE}.f90
+
+if [[ $UPDT = "YES" ]]
+then
+cp -p kk_kpp.f90    $DEFDIR/${OUTFILE}.f90
+echo " "
+echo "Write kpp module -- > " $DEFDIR/${OUTFILE}.f90
+fi
 
 if [[ $KEEP = "NO" ]]
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/create_kpp_module.C
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/create_kpp_module.C	(revision 3297)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/create_kpp_module.C	(revision 3298)
@@ -17,7 +17,24 @@
 //-----------------
 //$Id: create_kpp_module.C 2470 2017-09-14 13:56:42Z forkel $
+// forkel 25.09.2018:  added  automatic line with meechanism name (read mech_list)
+// forkel 20.09.2018:  added  vl_glo = size(tempi,1)
+// ketelsen 18.09.2018: Removed creation of fill_ Subroutine and creation of calls thereof
+//
+// forkel 12.09.2018: Fix in order not to loose the values of qvap and fakt
+//
+// forkel 03.09.2018: Bug fix: moved kppi.add_line("    CALL initialize after fakt = fakti(is)
+// forkel June 2018: added qvap and fakt, re-established original uppercase/lowercase 
+//                    Deleted definition of qvap,fakt in create_kpp_integrate again
+//
+// ketelsen July 2018: Changes for vector mode (edit_WAXPY, edit_FunTemplate, edit_JacTemplate, 
+//                            some cleanup of comments, various changes in create_kpp_integrate)
+//
+// forkel June 2018: Added qvap and fakt, re-established original uppercase/lowercase 
+//
+//
+/ 2017-09-14 13:56:42Z forkel $
 // Removed preprocessor directive __chem again 
 //
-/ 2017-09-14 13:56:42Z forkel $
+// 2017-09-14 13:56:42Z forkel $
 //
 // 
@@ -25,5 +42,5 @@
 //change of some output to lowercase with uppercase Fortran
 //
-// Nov 2016: Intial version (Klaus Ketelsen)
+// Nov 2016: Intial version of KP4 adapted to PALM (Klaus Ketelsen)
 //
 
@@ -49,15 +66,13 @@
    cout << "Create " << module_name << " from kpp Fortran sources" <<endl;
    cout << "Vector mode " << kpp_switches.is_vector() <<endl;
+   cout << "De_indexing " << kpp_switches.de_indexing() <<endl;
 
    create_fortran_files_and_read();
-   cout << "## after create_fortran_files_and_read " <<endl;
 
 // Generate first module lines 
 
      string first_line="MODULE " + module_name;
-     mz_kpp.add_line(first_line);
-     mz_kpp.add_line("!");
-//   mz_kpp.add_line("#if defined( __chem )");
-//   mz_kpp.add_line(" ");
+   mz_kpp.add_line(first_line);
+   mz_kpp.add_line(" ");
 
 //    string e5_line = first_line +"_e5";
@@ -93,5 +108,4 @@
      it->edit_fortran ();
    }
-   cout << "## after edit FORTRAN files            " <<endl;
 
 // Generate a list of single subroutines from kpp-files
@@ -109,7 +123,7 @@
    }
 
-
-   if(kpp_switches.is_vector()) {
-
+   if(kpp_switches.is_vector()) {
+
+   cout << "##### Hier kpp_switches.is_vector          " <<endl;
 //   Change header section
      for(it=kpp_includes.begin();it!=kpp_includes.end();it++) {
@@ -138,6 +152,15 @@
          it->edit_Fun();
        }
-     }
-   cout << "## after Edit individual subroutines    " <<endl;
+       if(it->get_name() == "WAXPY" ) {
+         it->edit_WAXPY();
+       }
+       if(it->get_name() == "FunTemplate" ) {
+         it->edit_FunTemplate();
+       }
+       if(it->get_name() == "JacTemplate" ) {
+         it->edit_JacTemplate();
+       }
+     }
+// cout << "## after Edit individual subroutines    " <<endl;
 
    }
@@ -146,7 +169,12 @@
 
    for(it=kpp_subroutines.begin();it!=kpp_subroutines.end();it++) {
-     if(it->get_name() == "update_rconst") {
+     if(it->get_name() == "Update_RCONST") {
        it->edit_Update_RCONST(Vvar_list);
      }
+
+     if(it->get_name() == "Initialize") {
+       it->edit_Initialize(Vvar_list);
+     }
+
    }
 
@@ -184,32 +212,15 @@
      }
 
-     buf = prefix + "INTERFACE            " + it->get_name() ;
+     buf = prefix + "interface            " + it->get_name() ;
      mz_kpp.add_line(buf);
-     buf = prefix + "  MODULE PROCEDURE   " + it->get_name();
+     buf = prefix + "  module procedure   " + it->get_name();
      mz_kpp.add_line(buf);
-     buf = prefix + "END INTERFACE        " + it->get_name();
+     buf = prefix + "end interface        " + it->get_name();
      mz_kpp.add_line(buf);
      mz_kpp.add_line(" ");
    }
-   for(iv=Vvar_list.begin();iv!=Vvar_list.end();iv++) {
-     string          buf;
-
-     string sub_name = "fill_" + iv->name;
-     buf = "  INTERFACE            " + sub_name;
-     mz_kpp.add_line(buf);
-     buf = "    MODULE PROCEDURE   " + sub_name;
-     mz_kpp.add_line(buf);
-     buf = "  END INTERFACE        " + sub_name;
-     mz_kpp.add_line(buf);
-     buf = "  PUBLIC               " + sub_name;
-     mz_kpp.add_line(buf);
-     mz_kpp.add_line(" ");
-   }
 
    mz_kpp.add_line(" ");
 
-   for(iv=Vvar_list.begin();iv!=Vvar_list.end();iv++) {
-     create_fill_routine(kpp_subroutines, *iv);
-   }
 
 // Copy FORTRAN subroutines to mz_kpp
@@ -224,19 +235,7 @@
 // Finish module
 
-//   mz_kpp.add_line("#endif");
-     string last_line="END MODULE " + module_name;
-     mz_kpp.add_line("");
-     mz_kpp.add_line(last_line);
-
-// Handle e5 module
-
-//    for(it=e5_subroutines.begin();it!=e5_subroutines.end();it++) {
-//      e5_kpp.add_line(" ");
-//      it->copy_to_MZ_KPP(e5_kpp);
-//    }
-
-//    last_line = last_line + "_e5";
-//    e5_kpp.add_line(" ");
-//    e5_kpp.add_line(last_line);
+   string last_line="end module " + module_name;
+   mz_kpp.add_line("");
+   mz_kpp.add_line(last_line);
 
 // Write the complete module to file: mz_kpp.f
@@ -376,4 +375,21 @@
    string                          diline;
 
+// Read mechanism from mech_list
+
+   in.open("mech_list");
+   if( !in ) {
+      cout << "cannot open " << endl; my_abort("mech_list");
+   }
+
+   while ( 1 ) {
+     getline (in, buf);
+     if( in.eof() ) break;
+     if( in.bad() ) my_abort("ERROR_READ_4");
+     line.set_line(buf);
+     mz_kpp.add_line(line);
+   }
+   in.close();
+
+
 // Read Modul Header from file $MZ_KPP_HOME/templates/module_header
 
@@ -394,40 +410,27 @@
    mz_kpp.add_line("                                                                 "); 
    if(kpp_switches.is_vector()) {
-       mz_kpp.add_line("  LOGICAL,  PARAMETER          :: l_vector = .TRUE.             ");
-   } else {
-       mz_kpp.add_line("  LOGICAL,  PARAMETER          :: l_vector = .FALSE.            ");
+       mz_kpp.add_line("  logical,parameter          :: L_VECTOR = .TRUE.             ");
+   } else {
+       mz_kpp.add_line("  logical,parameter          :: L_VECTOR = .FALSE.            ");
    }
 //  mz_pj_20070531+
    sprintf(distr,"%i",kpp_switches.de_indexing());
    diline = distr ;
-   mz_kpp.add_line("  INTEGER,  PARAMETER          :: i_lu_di = " + diline );
+   mz_kpp.add_line("  integer,parameter          :: I_LU_DI = " + diline );
 //  mz_pj_20070531-
 
-   mz_kpp.add_line("  INTEGER,  PARAMETER          :: vl_dim = " 
-                   + kpp_switches.get_vector_length() ); 
-   mz_kpp.add_line("  INTEGER                     :: vl                              "); 
+   mz_kpp.add_line("  integer,parameter          :: VL_DIM = " 
+                 + kpp_switches.get_vector_length() ); 
+   mz_kpp.add_line("  integer                     :: vl                              "); 
    mz_kpp.add_line("                                                                 "); 
-   mz_kpp.add_line("  INTEGER                     :: vl_glo                          "); 
-   mz_kpp.add_line("  INTEGER                     :: is,ie                           "); 
+   mz_kpp.add_line("  integer                     :: VL_glo                          "); 
+   mz_kpp.add_line("  integer                     :: is,ie                           "); 
    mz_kpp.add_line("                                                                 "); 
-   mz_kpp.add_line("  INTEGER,  DIMENSION(vl_dim)  :: kacc, krej                      "); 
-   mz_kpp.add_line("  INTEGER,  DIMENSION(vl_dim)  :: ierrv                           "); 
-   mz_kpp.add_line("  LOGICAL                     :: data_loaded = .false.             "); 
-   
+   mz_kpp.add_line("                                                                 "); 
+   mz_kpp.add_line("  integer, dimension(VL_dim)   :: Kacc,Krej                       "); 
+   mz_kpp.add_line("  integer, dimension(VL_dim)   :: IERRV                           "); 
+   mz_kpp.add_line("  logical                     :: data_loaded = .false.             "); 
+
    in.close();
-
-//    in_e5.open("module_header_e5");
-//    if( !in_e5 ) {
-//       cout << "cannot open " << endl; my_abort("module_header_e5");
-//    }
-
-//    while ( 1 ) {
-//      getline (in_e5, buf);
-//      if( in_e5.eof() ) break;
-//      if( in_e5.bad() ) my_abort("ERROR_READ_4");
-//      line.set_line(buf);
-//      e5_kpp.add_line(line);
-//    }
-//    in_e5.close();
 
    return;
@@ -448,13 +451,4 @@
    out.close();
    
-//    out_file  = "kk_mecca_kpp_e5.f90";
-//    out_e5.open(out_file.c_str(), ios::out);
-//    if( !out_e5 ) {
-//       cout << "cannot open " << endl; my_abort(out_file);
-//    }
-
-//    e5_kpp.write_file (out_e5);
-
-//    out_e5.close();
 
    return;
@@ -468,48 +462,73 @@
    kppi.set_name("chem_gasphase_integrate");
 
-   kppi.add_line("SUBROUTINE chem_gasphase_integrate (time_step_len, conc, tempk, photo, ierrf, xnacc, xnrej, istatus, l_debug, pe )  ");
+   kppi.add_line("SUBROUTINE chem_gasphase_integrate (time_step_len, conc, tempi, qvapi, fakti, photo, ierrf, xnacc, xnrej, istatus, l_debug, pe, icntrl_i, rcntrl_i )  ");
    kppi.add_line("                                                                    ");
    kppi.add_line("  IMPLICIT NONE                                                     ");
    kppi.add_line("                                                                    ");
 
-   kppi.add_line("  REAL(dp),  INTENT(IN)                    :: time_step_len           ");
+   kppi.add_line("  REAL(dp), INTENT(IN)                   :: time_step_len           ");
    kppi.add_line("  REAL(dp),  DIMENSION(:,:),  INTENT(INOUT) :: conc                    ");
-   kppi.add_line("  REAL(dp),  DIMENSION(:,:),  INTENT(INOUT) :: photo                   ");
-   kppi.add_line("  REAL(dp),  DIMENSION(:),  INTENT(IN)      :: tempk                   ");
-   kppi.add_line("  INTEGER,  INTENT(OUT),  OPTIONAL          :: ierrf(:)                ");
-   kppi.add_line("  INTEGER,  INTENT(OUT),  OPTIONAL          :: xnacc(:)                ");
-   kppi.add_line("  INTEGER,  INTENT(OUT),  OPTIONAL          :: xnrej(:)                ");
-   kppi.add_line("  INTEGER,  INTENT(INOUT),  OPTIONAL        :: istatus(:)              ");
-   kppi.add_line("  INTEGER,  INTENT(IN),  OPTIONAL           :: pe                      ");
-   kppi.add_line("  LOGICAL,  INTENT(IN),  OPTIONAL           :: l_debug                 ");
+   kppi.add_line("  REAL(dp),  DIMENSION(:,:),  INTENT(IN)    :: photo                   ");
+   kppi.add_line("  REAL(dp),  DIMENSION(:),  INTENT(IN)      :: tempi                   ");
+   kppi.add_line("  REAL(dp),  DIMENSION(:),  INTENT(IN)      :: qvapi                   ");
+   kppi.add_line("  REAL(dp),  DIMENSION(:),  INTENT(IN)      :: fakti                   ");
+   kppi.add_line("  INTEGER,  INTENT(OUT), OPTIONAL        :: ierrf(:)                ");
+   kppi.add_line("  INTEGER,  INTENT(OUT), OPTIONAL        :: xNacc(:)                ");
+   kppi.add_line("  INTEGER,  INTENT(OUT), OPTIONAL        :: xNrej(:)                ");
+   kppi.add_line("  INTEGER,  INTENT(INOUT), OPTIONAL      :: istatus(:)              ");
+   kppi.add_line("  INTEGER,  INTENT(IN), OPTIONAL         :: PE                      ");
+   kppi.add_line("  LOGICAL,  INTENT(IN), OPTIONAL         :: l_debug                 ");
+   kppi.add_line("  INTEGER,  DIMENSION(nkppctrl),INTENT(IN), OPTIONAL  :: icntrl_i         ");
+   kppi.add_line("  REAL(dp), DIMENSION(nkppctrl),INTENT(IN), OPTIONAL  :: rcntrl_i         ");
    kppi.add_line("                                                                    ");
    kppi.add_line("  INTEGER                                 :: k   ! loop variable     ");
    kppi.add_line("  REAL(dp)                                :: dt                      ");
-   kppi.add_line("  INTEGER,  DIMENSION(20)                  :: istatus_u               ");
-   kppi.add_line("  INTEGER                                 :: ierr_u                  ");
-   kppi.add_line("                                                                    ");
-   kppi.add_line("                                                                    ");
-   kppi.add_line("  if (present (istatus) )  istatus = 0                              ");
-   kppi.add_line("                                                                    ");
-// kppi.add_line("  vk_glo = size(tempk,1)                                            ");
-// kppi.add_line("                                                                    ");
-
-   kppi.add_line("  DO k=1,vl_glo,vl_dim                                              ");
+   kppi.add_line("  integer, dimension(20)                 :: istatus_u               ");
+   kppi.add_line("  integer                                :: ierr_u                  ");
+   kppi.add_line("  integer                                :: istatf                  ");
+   kppi.add_line("  integer                                :: vl_dim_lo               ");
+   kppi.add_line("                                                                    ");
+   kppi.add_line("                                                                    ");
+   kppi.add_line("  if (present (istatus) )   istatus = 0                             ");
+   kppi.add_line("  if (present (icntrl_i) )  icntrl  = icntrl_i                      ");
+   kppi.add_line("  if (present (rcntrl_i) )  rcntrl  = rcntrl_i                      ");
+   kppi.add_line("                                                                    ");
+   kppi.add_line("  vl_glo = size(tempi,1)                                            ");
+   kppi.add_line("                                                                    ");
+   kppi.add_line("  vl_dim_lo = VL_DIM                                                ");
+   kppi.add_line("  DO k=1,VL_glo,vl_dim_lo                                           ");
    kppi.add_line("    is = k                                                          ");
-   kppi.add_line("    ie = min(k+vl_dim-1,vl_glo)                                     ");
+   kppi.add_line("    ie = min(k+vl_dim_lo-1,VL_glo)                                  ");
    kppi.add_line("    vl = ie-is+1                                                    ");
 
    kppi.add_line("                                                                    ");
    if(kpp_switches.is_vector()) {
-     kppi.add_line("    c(1:vl,:) = conc(is:ie,:)                                     ");
-   } else {
-     kppi.add_line("    c(:) = conc(is,:)                                             ");
-   }
-   kppi.add_line("                                                                    ");
-   if(kpp_switches.is_vector()) {
-     kppi.add_line("    temp(1:vl) = tempk(is:ie)                                     ");
-   } else {
-     kppi.add_line("    temp = tempk(is)                                              ");
-   }
+     kppi.add_line("    C(1:vl,:) = Conc(is:ie,:)                                     ");
+   } else {
+     kppi.add_line("    C(:) = Conc(is,:)                                             ");
+   }
+
+   kppi.add_line("                                                                    ");
+   if(kpp_switches.is_vector()) {
+     kppi.add_line("    temp(1:vl) = tempi(is:ie)                                     ");
+   } else {
+     kppi.add_line("    temp = tempi(is)                                              ");
+   }
+   kppi.add_line("                                                                    ");
+   if(kpp_switches.is_vector()) {
+     kppi.add_line("    qvap(1:vl) = qvapi(is:ie)                                     ");
+   } else {
+     kppi.add_line("    qvap = qvapi(is)                                              ");
+   }
+   kppi.add_line("                                                                    ");
+   if(kpp_switches.is_vector()) {
+     kppi.add_line("    fakt(1:vl) = fakti(is:ie)                                     ");
+   } else {
+     kppi.add_line("    fakt = fakti(is)                                              ");
+   }
+
+   kppi.add_line("                                                                    ");
+   kppi.add_line("    CALL initialize                                                 ");
+
    kppi.add_line("                                                                    ");
    if(kpp_switches.is_vector()) {
@@ -528,10 +547,11 @@
    kppi.add_line("                                                                    ");
    if(kpp_switches.is_vector()) {
-     kppi.add_line("    conc(is:ie,:) = c(1:VL,:)                                     ");
-   } else {
-     kppi.add_line("    IF (PRESENT(l_debug) .AND. PRESENT(pe)) THEN                       ");
-     kppi.add_line("       IF (l_debug) CALL error_output(conc(is,:),ierr_u, pe)           ");
-     kppi.add_line("    ENDIF                                                              ");
-     kppi.add_line("    conc(is,:) = c(:)                                                  ");
+     kppi.add_line("    Conc(is:ie,:) = C(1:VL,:)                                     ");
+   } else {
+     kppi.add_line("   IF (PRESENT(l_debug) .AND. PRESENT(PE)) THEN                       ");
+     kppi.add_line("      IF (l_debug) CALL error_output(Conc(is,:),ierr_u, PE)           ");
+     kppi.add_line("   ENDIF                                                              ");
+     kppi.add_line("                                                                      ");
+     kppi.add_line("    Conc(is,:) = C(:)                                                 ");
    }
 
@@ -540,17 +560,17 @@
    kppi.add_line("                                                                    ");
    if(kpp_switches.is_vector()) {
-     kppi.add_line("    if(PRESENT(ierrf))    ierrf(is:ie) = ierrv(1:vl)              ");
-     kppi.add_line("    if(PRESENT(xnacc))    xnacc(is:ie) = kacc(1:vl)               ");
-     kppi.add_line("    if(PRESENT(xnrej))    xnrej(is:ie) = krej(1:vl)               ");
-   } else {
-     kppi.add_line("    if(PRESENT(ierrf))    ierrf(is) = ierr_u                      ");
-     kppi.add_line("    if(PRESENT(xnacc))    xnacc(is) = istatus_u(4)                ");
-     kppi.add_line("    if(PRESENT(xnrej))    xnrej(is) = istatus_u(5)                ");
-   }
-   kppi.add_line("                                                                    ");
-   kppi.add_line("    if (PRESENT (istatus) )  then                                   ");
-   if(kpp_switches.is_vector()) {
-     kppi.add_line("      istatus(4) =   istatus(4) + sum(kacc(1:vl))                  ");
-     kppi.add_line("      istatus(5) =   istatus(5) + sum(krej(1:vl))                  ");
+     kppi.add_line("    if(Present(ierrf))    ierrf(is:ie) = IERRV(1:VL)              ");
+     kppi.add_line("    if(Present(xNacc))    xNacc(is:ie) = Kacc(1:VL)               ");
+     kppi.add_line("    if(Present(xNrej))    xNrej(is:ie) = Krej(1:VL)               ");
+   } else {
+     kppi.add_line("    if(Present(ierrf))    ierrf(is) = IERR_U                      ");
+     kppi.add_line("    if(Present(xNacc))    xNacc(is) = istatus_u(4)                ");
+     kppi.add_line("    if(Present(xNrej))    xNrej(is) = istatus_u(5)                ");
+   }
+   kppi.add_line("                                                                    ");
+   kppi.add_line("    if (present (istatus) )  then                                   ");
+   if(kpp_switches.is_vector()) {
+     kppi.add_line("      istatus(4) =   istatus(4) + sum(Kacc(1:VL))                  ");
+     kppi.add_line("      istatus(5) =   istatus(5) + sum(Krej(1:VL))                  ");
      kppi.add_line("      istatus(3) =   istatus(4) + istatus(5)                       ");
      kppi.add_line("      istatus(6) =   istatus(6) + istatus_u(6)                     ");
@@ -559,5 +579,5 @@
      kppi.add_line("      istatus(1:8) = istatus(1:8) + istatus_u(1:8)                 ");
    }
-   kppi.add_line("    ENDIF                                                          ");
+   kppi.add_line("    end if                                                          ");
    kppi.add_line("                                                                    ");
    kppi.add_line("  END DO                                                            ");
@@ -568,5 +588,5 @@
    kppi.add_line("                                                                    ");
    for(iv=Vvar_list.begin();iv!=Vvar_list.end();iv++) {
-     kppi.add_line("  if (ALLOCATED("+ iv->name +"))   DEALLOCATE("+ iv->name +" )    ");
+//     kppi.add_line("  if (allocated("+ iv->name +"))   deallocate("+ iv->name +" )    ");
    }
 
@@ -574,5 +594,5 @@
    kppi.add_line("  data_loaded = .false.                                             ");
    kppi.add_line("                                                                    ");
-   kppi.add_line("  RETURN                                                            ");
+   kppi.add_line("  return                                                            ");
    kppi.add_line("END SUBROUTINE chem_gasphase_integrate                                        ");
 
@@ -583,60 +603,2 @@
 }
 
-void create_kpp_module::create_fill_routine(vector<fortran_file> &fi_list, Vvar & var) {
-   fortran_file                         fi;
-   vector<string>::iterator             is;
-   string                               line;
-
-   cout << "Generate fill subroutine for " << var.name << endl;
-
-   fi.set_name(var.name);
-   line = "  SUBROUTINE fill_" + var.name;
-   fi.add_line(line + "(status, array) ");
-     fi.add_line(" ");
-     fi.add_line("    INTEGER,  INTENT(OUT)               :: status ");
-   if(var.nr_dim() == 0) {
-     fi.add_line("    REAL(dp),  INTENT(IN),  DIMENSION(:) :: array ");
-     fi.add_line(" ");
-     fi.add_line("    status = 0");
-     fi.add_line("    IF (.not. ALLOCATED("+var.name+")) & ");
-     fi.add_line("       ALLOCATE("+var.name+"(size(array))) ");
-   } else if(var.nr_dim() == 1) {
-     fi.add_line("    REAL (dp), INTENT(IN), DIMENSION(:,:) :: array ");
-     fi.add_line(" ");
-     fi.add_line("    status = 0 ");
-     fi.add_line("    if (.not. ALLOCATED("+var.name+")) & ");
-     fi.add_line("        ALLOCATE("+var.name+"(size(array,1),"+var.dim_var[0]+")) ");
-   } else if(var.nr_dim() == 2) {
-     fi.add_line(" ");
-     fi.add_line("    REAL (dp), INTENT(IN), DIMENSION(:,:,:) :: array ");
-     fi.add_line(" ");
-     fi.add_line("    status = 0 ");
-     fi.add_line("    if (.not. ALLOCATED("+var.name+")) & ");
-     fi.add_line("        ALLOCATE("+var.name+"(size(array,1),"+var.dim_var[0]+var.dim_var[1]+")) ");
-   } else {
-     fi.add_line("    REAL (dp), INTENT(IN), DIMENSION(:,:,:,:) :: array ");
-     fi.add_line(" ");
-     fi.add_line("    status = 0 ");
-     fi.add_line("    IF (.not. ALLOCATED("+var.name+")) & ");
-     fi.add_line("        ALLOCATE("+var.name+"(size(array,1),"+var.dim_var[0]
-                               +var.dim_var[1]+var.dim_var[3]+")) ");
-   }
-
-   fi.add_line(" ");
-   fi.add_line("    IF (data_loaded .AND. (vl_glo /= size(array,1)) )  THEN ");
-   fi.add_line("       status = 1 ");
-   fi.add_line("       RETURN ");
-   fi.add_line("    END IF ");
-   fi.add_line(" ");
-   fi.add_line("    vl_glo = size(array,1) ");
-   fi.add_line("    "+var.name+ " = array ");
-   fi.add_line("    data_loaded = .TRUE. ");
-   fi.add_line(" ");
-   fi.add_line("    RETURN");
-   fi.add_line(" ");
-   fi.add_line("  END " + line);
-
-   fi_list.push_back(fi);
-
-   return;
-}
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/create_kpp_module.h
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/create_kpp_module.h	(revision 3297)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/create_kpp_module.h	(revision 3298)
@@ -1,14 +1,20 @@
 #ifndef mecca
-#define mecca 1
+// ketelsen 18.09.2018: Removed create_fill_routine
 
-// ############################################################################
-//
-//     create_mz_kpp_module 
-//
-//     create scalar code from .f90 sources created by KPP to be used in MESSy
-//
-//     COPYRIGHT Klaus Ketelsen and MPI-CH   April 2007
-//
-// ############################################################################
+#include <iostream>
+#include <fstream>
+
+#include <string>
+#include <list>
+#include <vector>
+
+#include "fortran_file.h"
+#include "expand_decomp.h"
+
+// Class to create module which contains code generated by kpp.
+
+/ 
+/ 
+// ketelsen 18.09.2018: Removed create_fill_routine
 
 #include <iostream>
@@ -48,6 +54,6 @@
 
   void create_kpp_integrate();
-  void create_fill_routine(vector<fortran_file> &e5_list, Vvar &var );
- public:
+
+public:
 
   void do_work (string s) ;
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/expand_decomp.C
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/expand_decomp.C	(revision 3297)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/expand_decomp.C	(revision 3298)
@@ -165,5 +165,5 @@
   vector<fortran_file>::iterator  it;
   fortran_file                    de;
-  int                             k,kk,j,jj,i,ii;
+  int                             k,kk,j,jj,i;
   string                          line;
   char                            cline[80];
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/fortran_file.C
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/fortran_file.C	(revision 3297)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/fortran_file.C	(revision 3298)
@@ -13,9 +13,19 @@
 //Current revisions:
 //------------------
-// 
-// 
+/ 
+/ 
 //Former revisions:
 //-----------------
 //$Id: fortran_file.C 2470 2017-09-14 13:56:42Z forkel $
+//  ketelsen 18.09.2018: (Rev 3260) added vector switch and creation of dimension statement
+//  forkel Sept.2018:  'fill_' routine applied to qvap and fakt
+//                      removal of unnecessary variables (LOOKAT, monitor etc. from Fortran code)
+//  forkel June 2018:  Moved adaption to PALM conventions to the end of the process
+//                     in order to make future use of vector code adaptations possible
+//  forkel 20.04.2018: Replace Roundoff = WLAMCH('E') by Roundoff = epsilon(one)
+// 
+// 
+// 
+/ 2017-09-14 13:56:42Z forkel $
 //
 // 
@@ -26,5 +36,5 @@
 //
 //
-// Nov 2016: Intial version (Klaus Ketelsen)
+// Nov 2016: Intial version of KP4 adapted to PALM (Klaus Ketelsen)
 //
 
@@ -62,7 +72,24 @@
      }
 
-// Now do some cosmetics to adapt the KPP generated output a bit o the looks of PALM, 
-// i.e. add some blanks, convert all to lowercase except Fortran language elements, etc.
-       if(line.find("'",0) == string::npos)  {     // No substitution in line with strings
+     if(line.find("'",0) == string::npos)  {     // No substitution in line with strings
+//     if(line.substr(0,4) !="!KPP") {
+//      global_substitute(line,"!"," ! ");
+//     if(line.substr(0,2) =="! ")   continue;           // No Substitute of Comments
+//     global_substitute(line,"("," ( ");
+//     global_substitute(line,")"," ) ");
+//     global_substitute(line,",",", ");
+//     global_substitute(line,"*","* ");
+//     global_substitute(line,"* *","**");
+//     global_substitute(line,"/JVS","/ JVS");
+//     global_substitute(line,"-","- ");
+//     global_substitute(line,"e- ","e-");
+//     global_substitute(line,"+","+ ");
+//     global_substitute(line,"d- ","d-");
+//     global_substitute(line,"D- ","D-");
+//     global_substitute(line,"e+ ","e+");
+//     global_substitute(line,"E+ ","E+");
+//     global_substitute(line,"E- ","E-");
+//      }
+
         if(line.substr(0,2) =="! ") {
          global_substitute(line,"#","#");      // just a dummy so comments do not get lost
@@ -77,48 +104,7 @@
          global_substitute(line,"/JVS","/ JVS");
          global_substitute(line,"-","- ");
-         global_substitute(line,"e- ","e-");
          global_substitute(line,"+","+ ");
          global_substitute(line,"+  ","+ ");
-         global_substitute(line,"d- ","d-");
-         global_substitute(line,"D- ","D-");
-         global_substitute(line,"e+ ","e+");
-         global_substitute(line,"E+ ","E+");
-         global_substitute(line,"E- ","E-");
-         global_substitute(line,")=",") =");
-         global_subtolower(line);
-         global_substitute(line,"call ","CALL ");
-         global_substitute(line,"case","CASE");
-         global_substitute(line,"character","CHARACTER");
-         global_substitute(line,"contains","CONTAINS");
-         global_substitute(line,"dimension","DIMENSION");
-         global_substitute(line,"do ","DO ");
-         global_substitute(line,"elseif","ELSEIF");
-         global_substitute(line,"else","ELSE");
-         global_substitute(line,"#ELSE","#else");
-         global_substitute(line,"end do","ENDDO");
-         global_substitute(line,"end if","ENDIF");
-         global_substitute(line,"end ","END ");    // Modify "end" after all other strings containing "end..." are done!
-         global_substitute(line,"#ENDIF","#endif");
-         global_substitute(line,"function","FUNCTION");
-         global_substitute(line,"if(","IF (");
-         global_substitute(line," if "," IF ");
-         global_substitute(line,"implicit","IMPLICIT");
-         global_substitute(line,"include","INCLUDE");
-         global_substitute(line,"intent","INTENT");
-         global_substitute(line,"integer","INTEGER");
-         global_substitute(line,"logical","LOGICAL");
-         global_substitute(line,"module","MODULE");
-         global_substitute(line,"none","NONE");
-         global_substitute(line,"optional","OPTIONAL");
-         global_substitute(line,"parameter","PARAMETER");
-         global_substitute(line,"public","PUBLIC");
-         global_substitute(line,"real","REAL");
-         global_substitute(line,"return","RETURN");
-         global_substitute(line,"use ","USE ");
-         global_substitute(line,"save","SAVE");
-         global_substitute(line,"subroutine","SUBROUTINE");
-         global_substitute(line,"then","THEN");
-         global_substitute(line,"while","WHILE");
-       }
+         }
      }
 
@@ -167,6 +153,5 @@
 //  Update_RCONST has only to be called once per outer timeloop in KPP_FOR_PALM
 
-//  if(ip->get_token(0) == "CALL" && ip->get_token(1) == "Update_RCONST" ) {
-    if(ip->get_token(0) == "CALL" && ip->get_token(1) == "update_rconst" ) {
+    if(ip->get_token(0) == "CALL" && ip->get_token(1) == "Update_RCONST" ) {
       lo_line.insert(0,"!DELETE ");
     cout << lo_line << endl;
@@ -175,6 +160,12 @@
 //  Update_SUN must not be called within in KPP_FOR_PALM
 
-//  if(ip->get_token(0) == "CALL" && ip->get_token(1) == "Update_SUN" ) {
-    if(ip->get_token(0) == "CALL" && ip->get_token(1) == "update_sun" ) {
+    if(ip->get_token(0) == "CALL" && ip->get_token(1) == "Update_SUN" ) {
+      lo_line.insert(0,"!DELETE ");
+    cout << lo_line << endl;
+    }
+
+//  Remove "    var(i) = x"  (Make sure  that var does not occur as first token anywhere else)
+
+    if(ip->get_token(0) == "VAR") {
       lo_line.insert(0,"!DELETE ");
     cout << lo_line << endl;
@@ -338,4 +329,93 @@
     }
 
+//  Remove  REAL(kind=dp):: sun
+
+    if(ip->get_token_number_from_string("SUN") > 0) {
+      lo_line.insert(0,"!DELETE ");
+    cout << lo_line << endl;
+    }
+
+//  Remove    INTEGER :: ddmtype
+
+    if(ip->get_token_number_from_string("DDMTYPE") > 0) {
+    cout << lo_line << endl;
+      lo_line.insert(0,"!DELETE ");
+    cout << lo_line << endl;
+    }
+
+//  Remove    REAL(kind=dp) :: dt
+
+    if(ip->get_token_number_from_string("DT") > 0) {
+    cout << lo_line << endl;
+      lo_line.insert(0,"!DELETE ");
+    cout << lo_line << endl;
+    }
+
+//  Remove    LOOKAT
+
+    if(ip->get_token_number_from_string("LOOKAT") > 0) {
+    cout << lo_line << endl;
+      lo_line.insert(0,"!DELETE ");
+    cout << lo_line << endl;
+    }
+
+//  Remove    NLOOKAT
+
+    if(ip->get_token_number_from_string("NLOOKAT") > 0) {
+    cout << lo_line << endl;
+      lo_line.insert(0,"!DELETE ");
+    cout << lo_line << endl;
+    }
+
+//  Remove    MONITOR
+
+    if(ip->get_token_number_from_string("MONITOR") > 0) {
+    cout << lo_line << endl;
+      lo_line.insert(0,"!DELETE ");
+    cout << lo_line << endl;
+    }
+
+//  Remove    NMONITOR
+
+    if(ip->get_token_number_from_string("NMONITOR") > 0) {
+    cout << lo_line << endl;
+      lo_line.insert(0,"!DELETE ");
+    cout << lo_line << endl;
+    }
+
+//  Remove    SMASS
+
+    if(ip->get_token_number_from_string("SMASS") > 0) {
+    cout << lo_line << endl;
+      lo_line.insert(0,"!DELETE ");
+    cout << lo_line << endl;
+    }
+
+//  Remove    RTOLS
+
+    if(ip->get_token_number_from_string("RTOLS") > 0) {
+    cout << lo_line << endl;
+      lo_line.insert(0,"!DELETE ");
+    cout << lo_line << endl;
+    }
+
+//  Remove    TEND
+
+    if(ip->get_token_number_from_string("TEND") > 0) {
+    cout << lo_line << endl;
+      lo_line.insert(0,"!DELETE ");
+    cout << lo_line << endl;
+    }
+
+//  Remove    STEPMAX
+
+    if(ip->get_token_number_from_string("STEPMAX") > 0) {
+    cout << lo_line << endl;
+      lo_line.insert(0,"!DELETE ");
+    cout << lo_line << endl;
+    }
+
+
+
 //  Make ind_ variables public
     if(ip->get_token(3).substr(0,4) == "ind_") {
@@ -464,8 +544,16 @@
        to_do = false;
     }
-    if(ip->get_token(0).substr(0,1) != "!" && ip->get_token_number_from_string("temp") > 2) {
-//  if(ip->get_token(0).substr(0,1) != "!" && ip->get_token_number_from_string("XXXX") > 2) {
-      todo_1 = true;
-    }
+    if(kpp_switches.is_vector()) {
+       if(ip->get_token(0).substr(0,1) != "!" && ip->get_token_number_from_string("TEMP") > 2) {
+         todo_1 = true;
+       }
+       if(ip->get_token(0).substr(0,1) != "!" && ip->get_token_number_from_string("QVAP") > 2) {
+         todo_1 = true;
+       }
+       if(ip->get_token(0).substr(0,1) != "!" && ip->get_token_number_from_string("FAKT") > 2) {
+         todo_1 = true;
+       }
+    }
+
     if(to_do || todo_1) {
       if(ip->get_token(0).substr(0,1) == "!") continue;       // skip comment limes
@@ -499,19 +587,24 @@
       cout << "Vector variable " << ip->get_token(pos+1) <<" " << vari.nr_dim() <<endl;
       lo_line = ip->get_line() ;
-      if(vari.nr_dim() == 0) {
-        lo_line.clear();
-        lo_line = "  REAL(dp),dimension(:),allocatable             :: " + vari.name;
-      }
-      if(vari.nr_dim() == 1) {
-        lo_line.clear();
-        lo_line = "  REAL(dp),dimension(:,:),allocatable           :: " + vari.name;
-      }
-      if(vari.nr_dim() == 2) {
-        lo_line.clear();
-        lo_line = "  REAL(dp),dimension(:,:,:),allocatable         :: " + vari.name;
-      }
-      if(vari.nr_dim() == 3) {
-        lo_line.clear();
-        lo_line = "  REAL(dp),dimension(:,:,:,:),allocatable       :: " + vari.name;
+      if(todo_1)   {
+          lo_line.clear();
+          lo_line = "  REAL(dp),dimension(VL_DIM)                  :: " + vari.name;
+      } else {
+         if(vari.nr_dim() == 0) {
+           lo_line.clear();
+           lo_line = "  REAL(dp),dimension(:),allocatable             :: " + vari.name;
+         }
+         if(vari.nr_dim() == 1) {
+           lo_line.clear();
+           lo_line = "  REAL(dp),dimension(:,:),allocatable           :: " + vari.name;
+         }
+         if(vari.nr_dim() == 2) {
+           lo_line.clear();
+           lo_line = "  REAL(dp),dimension(:,:,:),allocatable         :: " + vari.name;
+         }
+         if(vari.nr_dim() == 3) {
+           lo_line.clear();
+           lo_line = "  REAL(dp),dimension(:,:,:,:),allocatable       :: " + vari.name;
+         }
       }
       ip->set_line(lo_line);
@@ -541,5 +634,7 @@
 
   vector<program_line>::iterator     ip;
+  program_line                    pl;
   string                             lo_line;
+  string                             line;
 
   for (ip=pline.begin(); ip != pline.end(); ip++) {
@@ -555,6 +650,6 @@
     ip->global_substitute("* ","*");
     ip->global_substitute("* ","*");
-    ip->global_substitute("d- ","d-");
-    ip->global_substitute("d+ ","d+");
+//  ip->global_substitute("d- ","d-");
+//  ip->global_substitute("d+ ","d+");
     ip->global_substitute(", ",",");
     ip->global_substitute(")=",") =");
@@ -562,9 +657,108 @@
     ip->global_substitute(", - ",", -");
 
+// Now do some cosmetics to adapt the KPP generated output a bit o the looks of PALM, 
+// i.e. add some blanks, convert all to lowercase except Fortran language elements, etc.
+//  Replace Roundoff = WLAMCH('E') by Roundoff = epsilon(one)
+       ip->global_substitute("Roundoff = WLAMCH('E')","roundoff = epsilon(one)");
+       lo_line = ip->get_line();
+       if(lo_line.find("'",0) == string::npos)  {     // No substitution in line with strings
+        if(lo_line.substr(0,2) =="! ") {
+         ip->global_substitute("#","#");      // just a dummy so comments do not get lost
+         } else {
+//       cout << "HIER0 " << lo_line <<endl;
+//       global_substitute(lo_line,"("," ( ");
+//       global_substitute(lo_line,")"," ) ");
+         global_substitute(lo_line,",",", ");
+         global_substitute(lo_line,",  ",", ");
+         global_substitute(lo_line,")  ",") ");
+         global_substitute(lo_line,"*","* ");
+         global_substitute(lo_line,"* *","**");
+         global_substitute(lo_line,")+",") +");
+         global_substitute(lo_line,")-",") -");
+         global_substitute(lo_line,")/",") /");
+         global_substitute(lo_line,")*",") *");
+         global_substitute(lo_line,")=",") =");
+//       global_substitute(lo_line,"-","- ");
+         global_substitute(lo_line,"-  ","- ");
+         global_substitute(lo_line,"+","+ ");
+         global_substitute(lo_line,"+  ","+ ");
+         global_substitute(lo_line,"=- ","= -");
+         global_substitute(lo_line,"/JVS","/ JVS");
+         global_substitute(lo_line,"d- ","d-");
+         global_substitute(lo_line,"d+ ","d+");
+         global_substitute(lo_line,"D- ","D-");
+         global_substitute(lo_line,"D+ ","D+");
+         global_substitute(lo_line,"e- ","e-");
+         global_substitute(lo_line,"e+ ","e+");
+         global_substitute(lo_line,"E+ ","E+");
+         global_substitute(lo_line,"E- ","E-");
+         ip->global_subtolower(lo_line);
+         global_substitute(lo_line,"allocated","ALLOCATED");
+         global_substitute(lo_line,"allocatable","ALLOCATABLE");
+         global_substitute(lo_line,".and. ",".AND. ");
+         global_substitute(lo_line,"call ","CALL ");
+         global_substitute(lo_line,"case","CASE");
+         global_substitute(lo_line,"character","CHARACTER");
+         global_substitute(lo_line,"contains","CONTAINS");
+         global_substitute(lo_line,"deallocate","DEALLOCATE");
+         global_substitute(lo_line,"allocate","ALLOCATE");
+         global_substitute(lo_line,"dimension","DIMENSION");
+         global_substitute(lo_line,"do ","DO ");
+         global_substitute(lo_line,"elseif","ELSEIF");
+         global_substitute(lo_line,"else","ELSE");
+         global_substitute(lo_line,"#ELSE","#else");
+         global_substitute(lo_line,"end do","ENDDO");
+         global_substitute(lo_line,"end if","ENDIF");
+         global_substitute(lo_line,"endif","ENDIF");
+         global_substitute(lo_line,"endwhere","ENDWHERE");
+         global_substitute(lo_line,"end ","END ");    // Modify "end" after all other strings containing "end..." are done!
+         global_substitute(lo_line,"tEND","tend");
+         global_substitute(lo_line,"#ENDIF","#endif");
+         global_substitute(lo_line,"equivalence","EQUIVALENCE");
+         global_substitute(lo_line,"function","FUNCTION");
+         global_substitute(lo_line,"if(","IF (");
+         global_substitute(lo_line," if "," IF ");
+         global_substitute(lo_line,"implicit","IMPLICIT");
+         global_substitute(lo_line,"include","INCLUDE");
+         global_substitute(lo_line,"intent","INTENT");
+         global_substitute(lo_line,"integer","INTEGER");
+         global_substitute(lo_line,"interface","INTERFACE");
+         global_substitute(lo_line,"logical","LOGICAL");
+         global_substitute(lo_line,"module","MODULE");
+         global_substitute(lo_line,"none","NONE");
+         global_substitute(lo_line,"only","ONLY");
+         global_substitute(lo_line,"optional","OPTIONAL");
+         global_substitute(lo_line,"parameter","PARAMETER");
+         global_substitute(lo_line,"present","PRESENT");
+         global_substitute(lo_line,"private","PRIVATE");
+         global_substitute(lo_line,"procedure","PROCEDURE");
+         global_substitute(lo_line,"public","PUBLIC");
+         global_substitute(lo_line,"real","REAL");
+         global_substitute(lo_line,"return","RETURN");
+         global_substitute(lo_line,"use ","USE ");
+         global_substitute(lo_line,"save","SAVE");
+         global_substitute(lo_line,"subroutine","SUBROUTINE");
+         global_substitute(lo_line,"then","THEN");
+         global_substitute(lo_line,"where","WHERE");
+         global_substitute(lo_line,"while","WHILE");
+         global_substitute(lo_line,".false.",".FALSE.");
+         global_substitute(lo_line,".true.",".TRUE.");
+         global_substitute(lo_line,"(in)","(IN)");
+         global_substitute(lo_line,"(out)","(OUT)");
+         global_substitute(lo_line,"(inout)","(INOUT)");
+         global_substitute(lo_line,"\t","      ");
+//       cout << "HIER1 " << lo_line <<endl;
+       }
+     }
+//   pl.set_line(lo_line);
+//   pline.push_back(pl);
+
+
 //  line break if more than 130 character
 
-    lo_line = ip->get_line();
+//  lo_line = ip->get_line();
     if( lo_line.size() < 130 ) {
-      out << ip->get_line() <<endl;
+//    out << ip->get_line() <<endl;
+      out <<  lo_line    <<endl;
     } else {
       int cp  = lo_line.rfind("!",129);
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/fortran_file.h
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/fortran_file.h	(revision 3297)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/fortran_file.h	(revision 3298)
@@ -12,6 +12,16 @@
 // ############################################################################
 //
-//  Modifications:
-//    RFo added global_subtolower
+//Current revisions:
+//------------------
+/ 
+/ 
+//Former revisions:
+//-----------------
+// Nov 2016: Intial version of KP4 adapted to PALM (Klaus Ketelsen)
+//  forkel Sept.2018:  added edit_Initialize
+//  forkel          :  added global_subtolower
+//
+/ Intial version of KP4
+
 
 #include <iostream>
@@ -42,6 +52,10 @@
   void edit_KppSolve () ;
   void edit_Fun () ;
+  void edit_WAXPY () ;
+  void edit_FunTemplate () ;
+  void edit_JacTemplate () ;
   void edit_FUNC () ;
   void edit_Update_RCONST (vector <Vvar> &var_list) ;
+  void edit_Initialize (vector <Vvar> &var_list) ;
   void edit_inc (fortran_file & header_var) ;
   void create_species_list(vector <string> &species_list);
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/fortran_file_vec.C
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/fortran_file_vec.C	(revision 3297)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/fortran_file_vec.C	(revision 3298)
@@ -9,4 +9,21 @@
 //
 // ############################################################################
+//Current revisions:
+//------------------
+/ 
+/ 
+//Former revisions:
+//-----------------
+//$Id: fortran_file.C 2470 2017-09-14 13:56:42Z forkel $
+//  ketelsen 18.09.2018: Line 112: do k=is,ie bydo k=1,vl; line 156 ff: replaced index k by j
+//
+//  forkel Sept.2018:  added edit_Initialize
+//                     changed loop direction for update_rconst in edit_Update_RCONST
+/ 2017-09-14 13:56:42Z forkel $
+//
+//
+// Nov 2016: Intial version of KP4 adapted to PALM (Klaus Ketelsen)
+//
+
 
 #include <fstream>
@@ -77,8 +94,19 @@
     }
   }
+
+  for (ip=pline.begin(); ip != pline.end(); ip++) {
+      if(kpp_switches.is_vector() ) {
+    	  ip->global_substitute ("phot (","phot(j,");
+      }
+  }
+
   ip = pline.begin()+1 ;
   lo_line = ip->get_line() ;
   lo_line.erase();
-  lo_line = " INTEGER         :: j,k";
+  if(kpp_switches.is_vector() ) {
+    lo_line = " INTEGER         :: j,k";
+  } else {
+    lo_line = " INTEGER         :: k";
+  }
   ip->set_line(lo_line);
   
@@ -87,5 +115,5 @@
     lo_line = ip->get_line() ;
     lo_line.erase();
-    lo_line = " do k=is,ie";
+    lo_line = " do k=1,vl";
     ip->set_line(lo_line);
 
@@ -93,5 +121,5 @@
     lo_line = ip->get_line() ;
     lo_line.erase();
-    lo_line = "  j = k-is+1";
+    lo_line = "  j = k";
     ip->set_line(lo_line);
 
@@ -103,4 +131,68 @@
   } else {
     ip = pline.begin()+3 ;
+    lo_line = ip->get_line() ;
+    lo_line.erase();
+    lo_line = "  k = is";
+    ip->set_line(lo_line);
+  }
+
+  return;
+}
+
+void fortran_file::edit_Initialize (vector <Vvar> &var_list) {
+  vector<program_line>::iterator     ip;
+  vector<Vvar>::iterator             iv;
+  string                             lo_line;
+
+  for (ip=pline.begin(); ip != pline.end(); ip++) {
+    ip->global_substitute ("*"," *");
+    ip->global_substitute ("* *","**");
+    ip->global_substitute (","," , ");
+    ip->global_substitute ("/"," / ");
+    ip->global_substitute ("1:VL","j");
+  }
+  for (ip=pline.begin(); ip != pline.end(); ip++) {
+    for (iv=var_list.begin(); iv != var_list.end(); iv++) {
+      ip->change_variable_to_vector_g (*iv);
+    }
+  }
+
+  for (ip=pline.begin(); ip != pline.end(); ip++) {
+    if(kpp_switches.is_vector() ) {
+          ip->global_substitute ("qvap","qvap(j)");
+    }
+  }
+  for (ip=pline.begin(); ip != pline.end(); ip++) {
+    if(kpp_switches.is_vector() ) {
+          ip->global_substitute ("fakt","fakt(j)");
+    }
+  }
+
+  ip = pline.begin()+3 ;
+  lo_line = ip->get_line() ;
+  lo_line.erase();
+  lo_line = "  INTEGER         :: j,k";
+  ip->set_line(lo_line);
+
+  if(kpp_switches.is_vector() ) {
+    ip = pline.begin()+9 ;
+    lo_line = ip->get_line() ;
+    lo_line.erase();
+    lo_line = " do k = is,ie";
+    ip->set_line(lo_line);
+
+    ip = pline.begin()+10 ;
+    lo_line = ip->get_line() ;
+    lo_line.erase();
+    lo_line = "  j = k - is +1";
+    ip->set_line(lo_line);
+
+    ip = pline.end()-2 ;
+    lo_line = ip->get_line() ;
+//  lo_line.erase();
+    lo_line = " end do";
+    ip->set_line(lo_line);
+  } else {
+    ip = pline.begin()+7 ;
     lo_line = ip->get_line() ;
     lo_line.erase();
@@ -236,2 +328,73 @@
 }
 
+void fortran_file::edit_WAXPY () {
+
+  vector<program_line>::iterator     ip;
+
+  cout << "Handling subroutine: WAXPY" <<endl;
+
+  for (ip=pline.begin(); ip != pline.end(); ip++) {
+
+    if(ip->get_token(0) == "REAL") {
+       ip->substitute("N",":,:");
+       ip->substitute("N",":,:");
+       ip->substitute("Alpha","Alpha(:)");
+    } else {
+        ip->change_variable_to_vector ("Y");
+        ip->change_variable_to_vector ("X");
+        if(ip->get_token(0) != "SUBROUTINE") {
+        	if(ip->get_token(0) == "IF")  {
+        		ip->substitute("Alpha","SUM(alpha(1:VL))");
+        	} else {
+        		ip->substitute("Alpha","alpha(1:VL)");
+        	}
+        }
+    }
+
+
+  }
+
+  return;
+}
+
+void fortran_file::edit_FunTemplate () {
+
+  vector<program_line>::iterator     ip;
+
+  cout << "Handling subroutine: FunTemplate" <<endl;
+
+  for (ip=pline.begin(); ip != pline.end(); ip++) {
+
+    if(ip->get_token(0) == "REAL") {
+       ip->substitute("NVAR",":,:");
+       ip->substitute("T,","T(:),");
+       ip->substitute("Told","Told(size(T)),Time(size(T))");
+    }
+
+
+  }
+
+  return;
+}
+
+void fortran_file::edit_JacTemplate () {
+
+  vector<program_line>::iterator     ip;
+
+  cout << "Handling subroutine: JacTemplate" <<endl;
+
+  for (ip=pline.begin(); ip != pline.end(); ip++) {
+
+    if(ip->get_token(0) == "REAL") {
+        ip->substitute("NVAR",":,:");
+        ip->substitute("T,","T(:),");
+        ip->substitute("Told","Told(size(T)),Time(size(T))");
+        ip->substitute("LU_NONZERO",":,:");
+    }
+
+
+  }
+
+  return;
+}
+
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/program_line.C
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/program_line.C	(revision 3297)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/program_line.C	(revision 3298)
@@ -134,3 +134,17 @@
   return;
 }
+void   program_line::global_subtolower(string &line) {
 
+   int start = line.size()-1;
+   char c;
+
+    int i = 0;
+    while (line[i])
+    {
+      c = line[i];
+      line[i] = tolower(c);
+      i++;
+    }
+   return;
+}
+
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/program_line.h
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/program_line.h	(revision 3297)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/program_line.h	(revision 3298)
@@ -11,4 +11,6 @@
 //
 // ############################################################################
+//
+// forkel June 2018: added    void   global_subtolower(string &line);
 
 #include <iostream>
@@ -42,4 +44,5 @@
    void   change_variable_to_vector    (string var);
    void   change_variable_to_vector_g  (Vvar  &var);
+   void   global_subtolower(string &line);
 };
 
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/templates/Rosenbrock_vec.f90
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/templates/Rosenbrock_vec.f90	(revision 3298)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/templates/Rosenbrock_vec.f90	(revision 3298)
@@ -0,0 +1,1258 @@
+! NOTE: This routine is a vectorised version of Rosenbrock
+!       and can only be used with KP4.
+!
+SUBROUTINE Rosenbrock(N,Y,Tstart,Tend, &
+           AbsTol,RelTol,              &
+           RCNTRL,ICNTRL,RSTATUS,ISTATUS,IERR)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!    Solves the system y'=F(t,y) using a Rosenbrock method defined by:
+!
+!     G = 1/(H*gamma(1)) - Jac(t0,Y0)
+!     T_i = t0 + Alpha(i)*H
+!     Y_i = Y0 + \sum_{j=1}^{i-1} A(i,j)*K_j
+!     G * K_i = Fun( T_i, Y_i ) + \sum_{j=1}^S C(i,j)/H * K_j +
+!         gamma(i)*dF/dT(t0, Y0)
+!     Y1 = Y0 + \sum_{j=1}^S M(j)*K_j
+!
+!    For details on Rosenbrock methods and their implementation consult:
+!      E. Hairer and G. Wanner
+!      "Solving ODEs II. Stiff and differential-algebraic problems".
+!      Springer series in computational mathematics, Springer-Verlag, 1996.
+!    The codes contained in the book inspired this implementation.
+!
+!    (C)  Adrian Sandu, August 2004
+!    Virginia Polytechnic Institute and State University
+!    Contact: sandu@cs.vt.edu
+!    Revised by Philipp Miehe and Adrian Sandu, May 2006                  
+!    This implementation is part of KPP - the Kinetic PreProcessor
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!~~~>   INPUT ARGUMENTS:
+!
+!-     Y(N)    = vector of initial conditions (at T=Tstart)
+!-    [Tstart,Tend]  = time range of integration
+!     (if Tstart>Tend the integration is performed backwards in time)
+!-    RelTol, AbsTol = user precribed accuracy
+!- SUBROUTINE  Fun( T, Y, Ydot ) = ODE function,
+!                       returns Ydot = Y' = F(T,Y)
+!- SUBROUTINE  Jac( T, Y, Jcb ) = Jacobian of the ODE function,
+!                       returns Jcb = dFun/dY
+!-    ICNTRL(1:20)    = integer inputs parameters
+!-    RCNTRL(1:20)    = real inputs parameters
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!~~~>     OUTPUT ARGUMENTS:
+!
+!-    Y(N)    -> vector of final states (at T->Tend)
+!-    ISTATUS(1:20)   -> integer output parameters
+!-    RSTATUS(1:20)   -> real output parameters
+!-    IERR            -> job status upon return
+!                        success (positive value) or
+!                        failure (negative value)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!~~~>     INPUT PARAMETERS:
+!
+!    Note: For input parameters equal to zero the default values of the
+!       corresponding variables are used.
+!
+!    ICNTRL(1) = 1: F = F(y)   Independent of T (AUTONOMOUS)
+!              = 0: F = F(t,y) Depends on T (NON-AUTONOMOUS)
+!
+!    ICNTRL(2) = 0: AbsTol, RelTol are N-dimensional vectors
+!              = 1: AbsTol, RelTol are scalars
+!
+!    ICNTRL(3)  -> selection of a particular Rosenbrock method
+!        = 0 :    Rodas3 (default)
+!        = 1 :    Ros2
+!        = 2 :    Ros3
+!        = 3 :    Ros4F
+!        = 4 :    Rodas3
+!        = 5 :    Rodas4
+!
+!    ICNTRL(4)  -> maximum number of integration steps
+!        For ICNTRL(4)=0) the default value of 100000 is used
+!
+!    RCNTRL(1)  -> Hmin, lower bound for the integration step size
+!          It is strongly recommended to keep Hmin = ZERO
+!    RCNTRL(2)  -> Hmax, upper bound for the integration step size
+!    RCNTRL(3)  -> Hstart, starting value for the integration step size
+!
+!    RCNTRL(4)  -> FacMin, lower bound on step decrease factor (default=0.2)
+!    RCNTRL(5)  -> FacMax, upper bound on step increase factor (default=6)
+!    RCNTRL(6)  -> FacRej, step decrease factor after multiple rejections
+!                          (default=0.1)
+!    RCNTRL(7)  -> FacSafe, by which the new step is slightly smaller
+!         than the predicted value  (default=0.9)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!
+!    OUTPUT ARGUMENTS:
+!    -----------------
+!
+!    T           -> T value for which the solution has been computed
+!                     (after successful return T=Tend).
+!
+!    Y(N)        -> Numerical solution at T
+!
+!    IDID        -> Reports on successfulness upon return:
+!                    = 1 for success
+!                    < 0 for error (value equals error code)
+!
+!    ISTATUS(1)  -> No. of function calls
+!    ISTATUS(2)  -> No. of jacobian calls
+!    ISTATUS(3)  -> No. of steps
+!    ISTATUS(4)  -> No. of accepted steps
+!    ISTATUS(5)  -> No. of rejected steps (except at very beginning)
+!    ISTATUS(6)  -> No. of LU decompositions
+!    ISTATUS(7)  -> No. of forward/backward substitutions
+!    ISTATUS(8)  -> No. of singular matrix decompositions
+!
+!    RSTATUS(1)  -> Texit, the time corresponding to the
+!                     computed Y upon return
+!    RSTATUS(2)  -> Hexit, last accepted step before exit
+!    RSTATUS(3)  -> Hnew, last predicted step (not yet taken)
+!                   For multiple restarts, use Hnew as Hstart 
+!                     in the subsequent run
+!
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  USE cpulog,             ONLY: cpu_log, log_point_s
+
+  IMPLICIT NONE
+
+!~~~>  Arguments
+   INTEGER,       INTENT(IN)    :: N
+   REAL(kind=dp), INTENT(INOUT) :: Y(:,:)
+   REAL(kind=dp), INTENT(IN)    :: Tstart,Tend
+   REAL(kind=dp), INTENT(IN)    :: AbsTol(N),RelTol(N)
+   INTEGER,       INTENT(IN)    :: ICNTRL(20)
+   REAL(kind=dp), INTENT(IN)    :: RCNTRL(20)
+   INTEGER,       INTENT(INOUT) :: ISTATUS(20)
+   REAL(kind=dp), INTENT(INOUT) :: RSTATUS(20)
+   INTEGER, INTENT(OUT)   :: IERR
+!~~~>  Parameters of the Rosenbrock method, up to 6 stages
+   INTEGER ::  ros_S, rosMethod
+   INTEGER, PARAMETER :: RS2=1, RS3=2, RS4=3, RD3=4, RD4=5, RG3=6
+   REAL(kind=dp) :: ros_A(15), ros_C(15), ros_M(6), ros_E(6), &
+                    ros_Alpha(6), ros_Gamma(6), ros_ELO
+   LOGICAL :: ros_NewF(6)
+   CHARACTER(LEN=12) :: ros_Name
+!~~~>  Local variables
+   REAL(kind=dp) :: Roundoff, FacMin, FacMax, FacRej, FacSafe
+   REAL(kind=dp) :: Hmin, Hmax, Hstart
+   REAL(kind=dp) :: Texit
+   INTEGER       :: i, UplimTol, Max_no_steps
+   LOGICAL       :: Autonomous, VectorTol
+!~~~>   Parameters
+   REAL(kind=dp), PARAMETER :: ZERO = 0.0_dp, ONE  = 1.0_dp
+   REAL(kind=dp), PARAMETER :: DeltaMin = 1.0E-5_dp
+   INTEGER        :: solver_method
+
+
+!~~~>  Autonomous or time dependent ODE. Default is time dependent.
+   Autonomous = .NOT.(ICNTRL(1) == 0)
+
+!~~~>  For Scalar tolerances (ICNTRL(2).NE.0)  the code uses AbsTol(1) and RelTol(1)
+!   For Vector tolerances (ICNTRL(2) == 0) the code uses AbsTol(1:N) and RelTol(1:N)
+   IF (ICNTRL(2) == 0) THEN
+      VectorTol = .TRUE.
+      UplimTol  = N
+   ELSE
+      VectorTol = .FALSE.
+      UplimTol  = 1
+   END IF
+
+   solver_method = ICNTRL(3)
+
+!~~~>   Initialize the particular Rosenbrock method selected
+   SELECT CASE (solver_method)
+     CASE (1)
+       CALL Ros2
+     CASE (2)
+       CALL Ros3
+     CASE (3)
+       CALL Ros4
+     CASE (0,4)
+       CALL Rodas3
+     CASE (5)
+       CALL Rodas4
+     CASE (6)
+       CALL Rang3
+     CASE DEFAULT
+       PRINT * , 'Unknown Rosenbrock method: ICNTRL(3)=',ICNTRL(3) 
+       CALL ros_ErrorMsg(-2,Tstart,ZERO,IERR)
+       IERRV(:) = -2
+       RETURN
+   END SELECT
+
+!~~~>   The maximum number of steps admitted
+   IF (ICNTRL(4) == 0) THEN
+      Max_no_steps = 200000
+   ELSEIF (ICNTRL(4) > 0) THEN
+      Max_no_steps=ICNTRL(4)
+   ELSE
+      PRINT * ,'User-selected max no. of steps: ICNTRL(4)=',ICNTRL(4)
+      CALL ros_ErrorMsg(-1,Tstart,ZERO,IERR)
+      IERRV(:) = -1
+      RETURN
+   END IF
+
+!~~~>  Unit roundoff (1+Roundoff>1)
+   Roundoff = WLAMCH('E')
+
+!~~~>  Lower bound on the step size: (positive value)
+   IF (RCNTRL(1) == ZERO) THEN
+      Hmin = ZERO
+   ELSEIF (RCNTRL(1) > ZERO) THEN
+      Hmin = RCNTRL(1)
+   ELSE
+      PRINT * , 'User-selected Hmin: RCNTRL(1)=', RCNTRL(1)
+      CALL ros_ErrorMsg(-3,Tstart,ZERO,IERR)
+      IERRV(:) = -3
+      RETURN
+   END IF
+!~~~>  Upper bound on the step size: (positive value)
+   IF (RCNTRL(2) == ZERO) THEN
+      Hmax = ABS(Tend-Tstart)
+   ELSEIF (RCNTRL(2) > ZERO) THEN
+      Hmax = MIN(ABS(RCNTRL(2)),ABS(Tend-Tstart))
+   ELSE
+      PRINT * , 'User-selected Hmax: RCNTRL(2)=', RCNTRL(2)
+      CALL ros_ErrorMsg(-3,Tstart,ZERO,IERR)
+      IERRV(:) = -3
+      RETURN
+   END IF
+!~~~>  Starting step size: (positive value)
+   IF (RCNTRL(3) == ZERO) THEN
+      Hstart = MAX(Hmin,DeltaMin)
+   ELSEIF (RCNTRL(3) > ZERO) THEN
+      Hstart = MIN(ABS(RCNTRL(3)),ABS(Tend-Tstart))
+   ELSE
+      PRINT * , 'User-selected Hstart: RCNTRL(3)=', RCNTRL(3)
+      CALL ros_ErrorMsg(-3,Tstart,ZERO,IERR)
+      RETURN
+   END IF
+!~~~>  Step size can be changed s.t.  FacMin < Hnew/Hold < FacMax
+   IF (RCNTRL(4) == ZERO) THEN
+      FacMin = 0.2_dp
+   ELSEIF (RCNTRL(4) > ZERO) THEN
+      FacMin = RCNTRL(4)
+   ELSE
+      PRINT * , 'User-selected FacMin: RCNTRL(4)=', RCNTRL(4)
+      CALL ros_ErrorMsg(-4,Tstart,ZERO,IERR)
+      IERRV(:) = -4
+      RETURN
+   END IF
+   IF (RCNTRL(5) == ZERO) THEN
+      FacMax = 6.0_dp
+   ELSEIF (RCNTRL(5) > ZERO) THEN
+      FacMax = RCNTRL(5)
+   ELSE
+      PRINT * , 'User-selected FacMax: RCNTRL(5)=', RCNTRL(5)
+      CALL ros_ErrorMsg(-4,Tstart,ZERO,IERR)
+      IERRV(:) = -4
+      RETURN
+   END IF
+!~~~>   FacRej: Factor to decrease step after 2 succesive rejections
+   IF (RCNTRL(6) == ZERO) THEN
+      FacRej = 0.1_dp
+   ELSEIF (RCNTRL(6) > ZERO) THEN
+      FacRej = RCNTRL(6)
+   ELSE
+      PRINT * , 'User-selected FacRej: RCNTRL(6)=', RCNTRL(6)
+      CALL ros_ErrorMsg(-4,Tstart,ZERO,IERR)
+      IERRV(:) = -4
+      RETURN
+   END IF
+!~~~>   FacSafe: Safety Factor in the computation of new step size
+   IF (RCNTRL(7) == ZERO) THEN
+      FacSafe = 0.9_dp
+   ELSEIF (RCNTRL(7) > ZERO) THEN
+      FacSafe = RCNTRL(7)
+   ELSE
+      PRINT * , 'User-selected FacSafe: RCNTRL(7)=', RCNTRL(7)
+      CALL ros_ErrorMsg(-4,Tstart,ZERO,IERR)
+      IERRV(:) = -4
+      RETURN
+   END IF
+!~~~>  Check if tolerances are reasonable
+    DO i=1,UplimTol
+      IF ( (AbsTol(i) <= ZERO) .OR. (RelTol(i) <= 10.0_dp*Roundoff) &
+         .OR. (RelTol(i) >= 1.0_dp) ) THEN
+        PRINT * , ' AbsTol(',i,') = ',AbsTol(i)
+        PRINT * , ' RelTol(',i,') = ',RelTol(i)
+        CALL ros_ErrorMsg(-5,Tstart,ZERO,IERR)
+        RETURN
+      END IF
+    END DO
+
+
+!~~~>  CALL Rosenbrock method
+   CALL ros_Integrator(Y, Tstart, Tend, Texit,   &
+        AbsTol, RelTol,                          &
+!  Integration parameters
+        Autonomous, VectorTol, Max_no_steps,     &
+        Roundoff, Hmin, Hmax, Hstart,            &
+        FacMin, FacMax, FacRej, FacSafe,         &
+!  Error indicator
+        IERR)
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+CONTAINS !  SUBROUTINES internal to Rosenbrock
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
+ SUBROUTINE ros_ErrorMsg(Code,T,H,IERR)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
+!    Handles all error messages
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
+  
+   REAL(kind=dp), INTENT(IN) :: T, H
+   INTEGER, INTENT(IN)  :: Code
+   INTEGER, INTENT(OUT) :: IERR
+   
+   IERR = Code
+   PRINT * , &
+     'Forced exit from Rosenbrock due to the following error:' 
+     
+   SELECT CASE (Code)
+    CASE (-1)    
+      PRINT * , '--> Improper value for maximal no of steps'
+    CASE (-2)    
+      PRINT * , '--> Selected Rosenbrock method not implemented'
+    CASE (-3)    
+      PRINT * , '--> Hmin/Hmax/Hstart must be positive'
+    CASE (-4)    
+      PRINT * , '--> FacMin/FacMax/FacRej must be positive'
+    CASE (-5) 
+      PRINT * , '--> Improper tolerance values'
+    CASE (-6) 
+      PRINT * , '--> No of steps exceeds maximum bound'
+    CASE (-7) 
+      PRINT * , '--> Step size too small: T + 10*H = T', &
+            ' or H < Roundoff'
+    CASE (-8)    
+      PRINT * , '--> Matrix is repeatedly singular'
+    CASE DEFAULT
+      PRINT *, 'Unknown Error code: ', Code
+   END SELECT
+   
+!   PRINT *, "T=", T, "and H=", H
+     
+ END SUBROUTINE ros_ErrorMsg
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ SUBROUTINE ros_Integrator (Y, Tstart, Tend, Tout,  &
+        AbsTol, RelTol,                          &
+!~~~> Integration parameters
+        Autonomous, VectorTol, Max_no_steps,     &
+        Roundoff, Hmin, Hmax, Hstart,            &
+        FacMin, FacMax, FacRej, FacSafe,         &
+!~~~> Error indicator
+        IERR_out )
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!   Template for the implementation of a generic Rosenbrock method
+!      defined by ros_S (no of stages)
+!      and its coefficients ros_{A,C,M,E,Alpha,Gamma}
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+  USE kp4_compress,    ONLY: kco_initialize, kco_compress, &
+                             kco_finalize, cell_done
+  IMPLICIT NONE
+
+!~~~> Input: the initial condition at Tstart; Output: the solution at T
+   REAL(kind=dp), INTENT(INOUT) :: Y(:,:)
+!~~~> Input: integration interval
+   REAL(kind=dp), INTENT(IN) :: Tstart,Tend
+!~~~> Output: time at which the solution is returned (T=Tend if success)
+   REAL(kind=dp), INTENT(OUT) ::  Tout
+!~~~> Input: tolerances
+   REAL(kind=dp), INTENT(IN) ::  AbsTol(N), RelTol(N)
+!~~~> Input: integration parameters
+   LOGICAL, INTENT(IN) :: Autonomous, VectorTol
+   REAL(kind=dp), INTENT(IN) :: Hstart, Hmin, Hmax
+   INTEGER, INTENT(IN) :: Max_no_steps
+   REAL(kind=dp), INTENT(IN) :: Roundoff, FacMin, FacMax, FacRej, FacSafe
+!~~~> Output: Error indicator
+   INTEGER, INTENT(OUT) :: IERR_out
+! ~~~~ Local variables
+   REAL(kind=dp) :: Ynew(VL_DIM,N), Fcn0(VL_DIM,N), Fcn(VL_DIM,N)
+   REAL(kind=dp) :: K(VL_DIM,N*ros_S), dFdT(VL_DIM,N)
+   REAL(kind=dp) :: Jac0(VL_DIM,LU_NONZERO), Ghimj(VL_DIM,LU_NONZERO)
+!kk   REAL(kind=dp) :: H, Hnew, HC, HG, Fac, Tau
+   REAL(kind=dp) :: Yerr(VL_DIM,N)
+   REAL(kind=dp) :: Y_save(VL_DIM,N),Ynew_save(VL_DIM,N)
+   REAL(kind=dp) :: Hnew_save(VL_DIM)
+   INTEGER :: Pivot(N), Direction, ioffset, j, istage, i
+   LOGICAL :: Singular
+!~~~>  Local parameters
+   REAL(kind=dp), PARAMETER :: ZERO = 0.0_dp, ONE  = 1.0_dp
+   REAL(kind=dp), PARAMETER :: DeltaMin = 1.0E-5_dp
+
+   LOGICAL,SAVE             :: lfirst = .TRUE.
+!~~~>  Locally called functions
+!    REAL(kind=dp) WLAMCH
+!    EXTERNAL WLAMCH
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+!  vector compression algorithm
+
+   REAL(kind=dp), dimension(VL_dim)      :: T
+   REAL(kind=dp), dimension(VL_dim)      :: H, Hnew, HC, HC2, HG, Fac, Tau, Err,ros_v
+   LOGICAL, dimension(VL_dim)            :: RejectLastH, RejectMoreH
+   LOGICAL, dimension(VL_dim)            :: Accept_step,y_copied
+   integer                               :: vl_save
+   integer                               :: loop_count
+
+   if (lfirst)  then
+      write(9,'(a,i4,/)') 'kpp4palm vector version   ==> Vector length = ',vl_dim
+   end if
+
+!~~~>  Initial preparations
+   T(1:VL) = Tstart
+   RSTATUS(Nhexit) = ZERO
+   Tout    = Tend
+   H(1:VL) = MIN( MAX(ABS(Hmin),ABS(Hstart)) , ABS(Hmax) )
+   where (ABS(H(1:VL)) <= 10.0_dp*Roundoff) H(1:VL) = DeltaMin
+
+
+   IF (Tend  >=  Tstart) THEN
+     Direction = +1
+   ELSE
+     Direction = -1
+   END IF
+   H = Direction*H
+
+   RejectLastH(1:VL)=.FALSE.
+   RejectMoreH(1:VL)=.FALSE.
+
+   loop_count = 0
+!~~~> Time loop begins below
+
+   IERRV(1:VL) = 1  ! successful integration
+   vl_save          = VL
+   Kacc       = 0
+   Krej       = 0
+
+!kk   IF (.not. l_fixed_step) then
+      call kco_initialize (VL, y, IERRV, Kacc, Krej)
+!kk   end if
+
+TimeLoop: DO
+!kk Eventuell als Where einbauen
+   where ( (Direction > 0).AND.((T(1:VL)-Tend)+Roundoff <= ZERO) &
+        .OR. (Direction < 0).AND.((Tend-T(1:VL))+Roundoff <= ZERO) )
+      cell_done(1:VL) = .FALSE.
+   elsewhere
+      cell_done(1:VL) = .TRUE.
+   end where
+!   do i=1,vl
+!      if ( (Direction > 0).AND.((T(i)-Tend)+Roundoff <= ZERO) &
+!        .OR. (Direction < 0).AND.((Tend-T(i))+Roundoff <= ZERO) )  then
+!         cell_done(i) = .FALSE.
+!      else
+!         cell_done(i) = .TRUE.
+!       end if
+!   end do
+
+   if(count(cell_done(1:VL)) == vl_save)   then                      ! EXIT 1, all cells converge at the same time
+      EXIT                                                           ! Iteration terminates without without compress
+   end if
+
+   loop_count = loop_count+1
+
+   call kco_compress (VL, T, H, Hnew, IERRV, y, RCONST, FIX, RejectLastH, RejectMoreH, Kacc, Krej)
+
+   if(all(cell_done(1:VL)))  then                                    ! EXIT 2, all cells converge have been converged
+     EXIT
+   end if
+
+   IF ( ISTATUS(Nstp) > Max_no_steps ) THEN  ! Too many steps
+      CALL ros_ErrorMsg(-6,T(1),H(1),IERR)
+      IERRV(1:VL) = -6
+      RETURN
+   END IF
+
+   IERRV = 0
+   WHERE ( ((T(1:VL)+0.1_dp*H(1:VL)) == T(1)).OR.(H(1:VL) <= Roundoff) )   ! Step size too small
+      IERRV(1:VL) = -7
+   END WHERE
+
+   IF(MINVAL(IERRV) == -7)   then
+      CALL ros_ErrorMsg(-7,T(1),H(1),IERR)
+      RETURN
+    END IF
+
+!~~~>  Limit H if necessary to avoid going beyond Tend
+   H(1:VL) = MIN(H(1:VL),ABS(Tend-T(1:VL)))
+
+!~~~>   Compute the function at current time
+   CALL FunTemplate(T,Y,Fcn0)
+   ISTATUS(Nfun) = ISTATUS(Nfun) + 1
+
+!~~~>  Compute the function derivative with respect to T
+   IF (.NOT.Autonomous) THEN
+      CALL ros_FunTimeDerivative ( T, Roundoff, Y, &
+                Fcn0, dFdT )
+   END IF
+
+!~~~>   Compute the Jacobian at current time
+   CALL JacTemplate(T,Y,Jac0)
+   ISTATUS(Njac) = ISTATUS(Njac) + 1                            ! This is not correct in vector mode, please use xnacc and xnrej
+
+!~~~>  Repeat step calculation until current step accepted
+    Accept_step(1:VL) = .FALSE.
+    y_copied(1:VL)    = .FALSE.
+
+UntilAccepted: DO
+
+   CALL ros_PrepareMatrix(H,Direction,ros_Gamma(1), &
+          Jac0,Ghimj,Pivot,Singular)
+   IF (Singular) THEN ! More than 5 consecutive failed decompositions
+       CALL ros_ErrorMsg(-8,T(1),H(1),IERR)
+       RETURN
+   END IF
+
+!~~~>   Compute the stages
+Stage: DO istage = 1, ros_S
+
+!      Current istage offset. Current istage vector is K(ioffset+1:ioffset+N)
+       ioffset = N*(istage-1)
+
+!      For the 1st istage the function has been computed previously
+       IF ( istage == 1 ) THEN
+         Fcn(1:VL,1:N) = Fcn0(1:VL,1:N) 
+      ! istage>1 and a new function evaluation is needed at the current istage
+       ELSEIF ( ros_NewF(istage) ) THEN
+	   Ynew(1:VL,1:N) = Y(1:VL,1:N)
+        DO j = 1, istage-1
+!           ros_v = ros_A((istage-1)*(istage-2)/2+j)
+!           CALL WAXPY(N,ros_v,K(:,N*(j-1)+1:N*(j-1)+N),1,Ynew,1)
+            Ynew(1:vl,1:N) = Ynew(1:vl,1:N)+ros_A((istage-1)*(istage-2)/2+j)*K(1:VL,N*(j-1)+1:N*(j-1)+N)
+         END DO
+         Tau = T + ros_Alpha(istage)*Direction*H
+         CALL FunTemplate(Tau,Ynew,Fcn)
+         ISTATUS(Nfun) = ISTATUS(Nfun) + 1
+       END IF ! if istage == 1 elseif ros_NewF(istage)
+       K(1:VL,ioffset+1:ioffset+N) = Fcn(1:VL,1:N)
+       DO j = 1, istage-1
+         HC(1:vl) = ros_C((istage-1)*(istage-2)/2+j)/(Direction*H(1:vl))
+!         CALL WAXPY(N,HC,K(:,N*(j-1)+1:N*(j-1)+N),1,K(:,ioffset+1:ioffset+n),1)
+         DO i=1,N
+            K(1:vl,ioffset+i) = K(1:vl,ioffset+i) + HC(1:vl)*K(1:vl,N*(j-1)+i)
+         END DO
+
+       END DO
+       IF ((.NOT. Autonomous).AND.(ros_Gamma(istage).NE.ZERO)) THEN
+         HG(1:vl) = Direction*H(1:vl)*ros_Gamma(istage)
+         CALL WAXPY(N,HG,dFdT,1,K(:,ioffset+1:ioffset+n),1)
+       END IF
+
+       CALL ros_Solve(Ghimj, K(:,ioffset+1:ioffset+n))
+
+   END DO Stage
+
+
+!~~~>  Compute the new solution
+   Ynew(1:vl,1:N) = Y(1:vl,1:N)
+   DO j=1,ros_S
+         ros_v = ros_M(j)
+         CALL WAXPY(N,ros_v,K(:,N*(j-1)+1:),1,Ynew,1)
+   END DO
+
+!~~~>  Compute the error estimation
+   Yerr(1:vl,1:N) = ZERO
+   DO j=1,ros_S
+        ros_v = ros_E(j)
+        CALL WAXPY(N,ros_v,K(:,N*(j-1)+1:N*(j-1)+N),1,Yerr,1)
+   END DO
+   Err(1:VL) = ros_ErrorNorm ( Y, Ynew, Yerr, AbsTol, RelTol, VectorTol )
+
+!~~~> New step size is bounded by FacMin <= Hnew/H <= FacMax
+   Fac(1:vl)  = MIN(FacMax,MAX(FacMin,FacSafe/Err(1:vl)**(ONE/ros_ELO)))
+   Hnew(1:vl) = H(1:vl)*Fac(1:vl)
+
+!~~~>  Check the error magnitude and adjust step size
+   ISTATUS(Nstp) = ISTATUS(Nstp) + 1
+!   write(9,*) 'Hmin ',Hmin,Hmax
+ do i=1,VL
+    IF(Accept_step(i))   then
+       Ynew(i,:) = Ynew_save(i,:)
+       Hnew(i)   = Hnew_save(i)
+    ELSE IF ( (Err(i) <= ONE).OR.(H(i) <= Hmin) ) THEN  !~~~> Accept step
+      ISTATUS(Nacc) = ISTATUS(Nacc) + 1
+      Y(i,1:N) = Ynew(i,1:N)
+      T(i) = T(i) + Direction*H(i)
+      Hnew(i) = MAX(Hmin,MIN(Hnew(i),Hmax))
+      IF (RejectLastH(i)) THEN  ! No step size increase after a rejected step
+         Hnew(i) = MIN(Hnew(i),H(i))
+      END IF
+      RSTATUS(Nhexit) = H(i)                    ! ueberdenken
+      RSTATUS(Nhnew)  = Hnew(i)
+      RSTATUS(Ntexit) = T(i)                    ! ueberdenken ende
+      RejectLastH(i) = .FALSE.
+      RejectMoreH(i) = .FALSE.
+      H(i) = Hnew(i)
+
+      Accept_step(i) = .TRUE.                   ! EXIT THE LOOP: WHILE STEP NOT ACCEPTED
+      Kacc(i) = Kacc(i) +1
+   ELSE           !~~~> Reject step
+      IF (RejectMoreH(i)) THEN
+         Hnew (i)= H(i)*FacRej
+      END IF
+      RejectMoreH(i) = RejectLastH(i)
+      RejectLastH(i) = .TRUE.
+      H(i) = Hnew(i)
+
+      IF (ISTATUS(Nacc) >= 1)  ISTATUS(Nrej) = ISTATUS(Nrej) + 1
+      Krej(i) = Krej(i)+1
+
+   END IF ! Err <= 1
+  END DO
+   if(all(Accept_step(1:VL)))   EXIT
+
+   do i=1,VL
+      IF(Accept_step(i))   then
+         if(.not. y_copied(i))  then
+            y_save(i,:)    = y(i,:)
+            Ynew_save(i,:) = Ynew(i,:)
+            Hnew_save(i)   = Hnew(i)
+            y_copied(i) = .TRUE.
+         end if
+      end if
+   end do
+
+
+   END DO UntilAccepted
+
+    do i=1,VL
+       if(y_copied(i))  then
+           y(i,:)  = y_save(i,:)
+       end if
+    end do
+
+   END DO TimeLoop
+
+   call kco_finalize (y, IERRV, Kacc, Krej)
+
+   VL = VL_save
+
+!~~~> Succesful exit
+   IERR_out = 1  !~~~> The integration was successful
+
+   lfirst = .FALSE.
+
+  END SUBROUTINE ros_Integrator
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  FUNCTION ros_ErrorNorm ( Y, Ynew, Yerr, &
+               AbsTol, RelTol, VectorTol )
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> Computes the "scaled norm" of the error vector Yerr
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   IMPLICIT NONE
+
+! Input arguments
+   REAL(kind=dp), INTENT(IN) :: Y(:,:), Ynew(:,:), &
+          Yerr(:,:), AbsTol(N), RelTol(N)
+   LOGICAL, INTENT(IN) ::  VectorTol
+! Local variables
+   REAL(kind=dp), dimension(VL)       :: Err, Scale, Ymax
+   INTEGER  :: i,j
+   REAL(kind=dp), PARAMETER           :: ZERO = 0.0_dp
+   REAL(kind=dp), dimension(VL)       :: ros_ErrorNorm
+
+   Err = ZERO
+   DO i=1,NVAR
+       do j=1,VL
+           Ymax(j) = MAX( ABS(Y(j,i)),ABS(Ynew(j,i)))
+           IF (VectorTol) THEN
+               Scale(j) = AbsTol(i)+ RelTol(i)*Ymax(j)
+           ELSE
+               Scale(j) = AbsTol(1)+ RelTol(1)*Ymax(1)
+           END IF
+           Err(j) = Err(j)+ (Yerr(j,i)/Scale(j))**2
+       end do
+   END DO
+   Err  = SQRT(Err/N)
+
+   ros_ErrorNorm = max(err, 1.0d-10)
+
+  END FUNCTION ros_ErrorNorm
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_FunTimeDerivative ( T, Roundoff, Y, &
+                Fcn0, dFdT )
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> The time partial derivative of the function by finite differences
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   IMPLICIT NONE
+
+!~~~> Input arguments
+   REAL(kind=dp), INTENT(IN) :: T(:), Roundoff, Y(:,:), Fcn0(:,:)
+!~~~> Output arguments
+   REAL(kind=dp), INTENT(OUT) :: dFdT(:,:)
+!~~~> Local variables
+   REAL(kind=dp) :: Delta(1:vl_dim),one_v(1:vl_dim)
+   REAL(kind=dp), PARAMETER :: ONE = 1.0_dp, DeltaMin = 1.0E-6_dp
+   INTEGER   :: i
+
+   Delta(1:vl) = SQRT(Roundoff)*MAX(DeltaMin,ABS(T(1:vl)))
+   CALL FunTemplate(T(1:vl)+Delta(1:vl),Y,dFdT)
+   ISTATUS(Nfun) = ISTATUS(Nfun) + 1
+   one_v = -ONE
+   CALL WAXPY(N,one_v,Fcn0,1,dFdT,1)
+!   CALL WSCAL(N,(ONE/Delta),dFdT,1)
+   do i=1,size(dFdT,2)
+      dFdT(1:vl,i) = 1.0_dp/Delta(1:vl)*dFdT(1:vl,i)
+   end do
+
+  END SUBROUTINE ros_FunTimeDerivative
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_PrepareMatrix ( H, Direction, gam, &
+             Jac0, Ghimj, Pivot, Singular )
+! --- --- --- --- --- --- --- --- --- --- --- --- ---
+!  Prepares the LHS matrix for stage calculations
+!  1.  Construct Ghimj = 1/(H*ham) - Jac0
+!      "(Gamma H) Inverse Minus Jacobian"
+!  2.  Repeat LU decomposition of Ghimj until successful.
+!       -half the step size if LU decomposition fails and retry
+!       -exit after 5 consecutive fails
+! --- --- --- --- --- --- --- --- --- --- --- --- ---
+   IMPLICIT NONE
+
+!~~~> Input arguments
+   REAL(kind=dp), INTENT(IN) ::  Jac0(:,:)
+   REAL(kind=dp), INTENT(IN) ::  gam
+   INTEGER, INTENT(IN) ::  Direction
+!~~~> Output arguments
+   REAL(kind=dp), INTENT(OUT) :: Ghimj(:,:)
+
+   LOGICAL, INTENT(OUT) ::  Singular
+   INTEGER, INTENT(OUT) ::  Pivot(N)
+!~~~> Inout arguments
+   REAL(kind=dp), INTENT(INOUT) :: H(:)   ! step size is decreased when LU fails
+!~~~> Local variables
+   INTEGER  :: i, ISING, Nconsecutive
+   REAL(kind=dp) :: ghinv(1:VL)
+   REAL(kind=dp), PARAMETER :: ONE  = 1.0_dp, HALF = 0.5_dp
+
+   Nconsecutive = 0
+   Singular = .FALSE.
+
+!kk   DO WHILE (Singular)                        !test of Singular currently disabled
+
+!~~~>    Construct Ghimj = 1/(H*gam) - Jac0
+   Ghimj(1:VL,1:LU_NONZERO) = -JAC0(1:VL,1:LU_NONZERO)
+   ghinv(1:VL) = 1.0_dp/(H(1:VL)*gam)
+   DO i=1,N
+     Ghimj(1:VL,LU_DIAG(i)) = Ghimj(1:VL,LU_DIAG(i))+ghinv(1:VL)
+   END DO
+
+!~~~>    Compute LU decomposition
+   CALL KppDecomp( Ghimj, ising )
+
+!kk Original code, implement singular check if necessary
+!!~~~>    Compute LU decomposition
+!     CALL ros_Decomp( Ghimj, Pivot, ISING )
+!     IF (ISING == 0) THEN
+!!~~~>    If successful done
+!        Singular = .FALSE.
+!     ELSE ! ISING .ne. 0
+!!~~~>    If unsuccessful half the step size; if 5 consecutive fails then return
+!        ISTATUS(Nsng) = ISTATUS(Nsng) + 1
+!        Nconsecutive = Nconsecutive+1
+!        Singular = .TRUE.
+!        PRINT*,'Warning: LU Decomposition returned ISING = ',ISING
+!        IF (Nconsecutive <= 5) THEN ! Less than 5 consecutive failed decompositions
+!           H = H*HALF
+!        ELSE  ! More than 5 consecutive failed decompositions
+!           RETURN
+!        END IF  ! Nconsecutive
+!      END IF    ! ISING
+
+!    END DO ! WHILE Singular
+
+     Pivot = 0                                !Set to avoid compiler warnings
+
+  END SUBROUTINE ros_PrepareMatrix
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  SUBROUTINE ros_Decomp( A, Pivot, ISING )
+!!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!!  Template for the LU decomposition
+!!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!   IMPLICIT NONE
+!!~~~> Inout variables
+!#ifdef FULL_ALGEBRA
+!   REAL(kind=dp), INTENT(INOUT) :: A(N,N)
+!#else
+!   REAL(kind=dp), INTENT(INOUT) :: A(LU_NONZERO)
+!#endif
+!!~~~> Output variables
+!   INTEGER, INTENT(OUT) :: Pivot(N), ISING
+!
+!#ifdef FULL_ALGEBRA
+!   CALL  DGETRF( N, N, A, N, Pivot, ISING )
+!#else
+!   CALL KppDecomp ( A, ISING )
+!   Pivot(1) = 1
+!#endif
+!   ISTATUS(Ndec) = ISTATUS(Ndec) + 1
+!
+!  END SUBROUTINE ros_Decomp
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_Solve( A, b )
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the forward/backward substitution (using pre-computed LU decomposition)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   IMPLICIT NONE
+!~~~> Input variables
+   REAL(kind=dp), INTENT(IN)         :: A(:,:)
+!~~~> InOut variables
+   REAL(kind=dp), INTENT(INOUT)      :: b(:,:)
+
+   CALL KppSolve( A, b )
+
+   ISTATUS(Nsol) = ISTATUS(Nsol) + VL
+
+  END SUBROUTINE ros_Solve
+
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE Ros2
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! --- AN L-STABLE METHOD, 2 stages, order 2
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+   IMPLICIT NONE
+   DOUBLE PRECISION g
+
+    g = 1.0_dp + 1.0_dp/SQRT(2.0_dp)
+    rosMethod = RS2
+!~~~> Name of the method
+    ros_Name = 'ROS-2'
+!~~~> Number of stages
+    ros_S = 2
+
+!~~~> The coefficient matrices A and C are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1), A(3,1)=ros_A(2), A(3,2)=ros_A(3), etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j )
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j )
+
+    ros_A(1) = (1.0_dp)/g
+    ros_C(1) = (-2.0_dp)/g
+!~~~> Does the stage i require a new function evaluation (ros_NewF(i)=TRUE)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i)=FALSE)
+    ros_NewF(1) = .TRUE.
+    ros_NewF(2) = .TRUE.
+!~~~> M_i = Coefficients for new step solution
+    ros_M(1)= (3.0_dp)/(2.0_dp*g)
+    ros_M(2)= (1.0_dp)/(2.0_dp*g)
+! E_i = Coefficients for error estimator
+    ros_E(1) = 1.0_dp/(2.0_dp*g)
+    ros_E(2) = 1.0_dp/(2.0_dp*g)
+!~~~> ros_ELO = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus one
+    ros_ELO = 2.0_dp
+!~~~> Y_stage_i ~ Y( T + H*Alpha_i )
+    ros_Alpha(1) = 0.0_dp
+    ros_Alpha(2) = 1.0_dp
+!~~~> Gamma_i = \sum_j  gamma_{i,j}
+    ros_Gamma(1) = g
+    ros_Gamma(2) =-g
+
+ END SUBROUTINE Ros2
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE Ros3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! --- AN L-STABLE METHOD, 3 stages, order 3, 2 function evaluations
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+   IMPLICIT NONE
+   rosMethod = RS3
+!~~~> Name of the method
+   ros_Name = 'ROS-3'
+!~~~> Number of stages
+   ros_S = 3
+
+!~~~> The coefficient matrices A and C are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1), A(3,1)=ros_A(2), A(3,2)=ros_A(3), etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j )
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j )
+
+   ros_A(1)= 1.0_dp
+   ros_A(2)= 1.0_dp
+   ros_A(3)= 0.0_dp
+
+   ros_C(1) = -0.10156171083877702091975600115545E+01_dp
+   ros_C(2) =  0.40759956452537699824805835358067E+01_dp
+   ros_C(3) =  0.92076794298330791242156818474003E+01_dp
+!~~~> Does the stage i require a new function evaluation (ros_NewF(i)=TRUE)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i)=FALSE)
+   ros_NewF(1) = .TRUE.
+   ros_NewF(2) = .TRUE.
+   ros_NewF(3) = .FALSE.
+!~~~> M_i = Coefficients for new step solution
+   ros_M(1) =  0.1E+01_dp
+   ros_M(2) =  0.61697947043828245592553615689730E+01_dp
+   ros_M(3) = -0.42772256543218573326238373806514_dp
+! E_i = Coefficients for error estimator
+   ros_E(1) =  0.5_dp
+   ros_E(2) = -0.29079558716805469821718236208017E+01_dp
+   ros_E(3) =  0.22354069897811569627360909276199_dp
+!~~~> ros_ELO = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus 1
+   ros_ELO = 3.0_dp
+!~~~> Y_stage_i ~ Y( T + H*Alpha_i )
+   ros_Alpha(1)= 0.0_dp
+   ros_Alpha(2)= 0.43586652150845899941601945119356_dp
+   ros_Alpha(3)= 0.43586652150845899941601945119356_dp
+!~~~> Gamma_i = \sum_j  gamma_{i,j}
+   ros_Gamma(1)= 0.43586652150845899941601945119356_dp
+   ros_Gamma(2)= 0.24291996454816804366592249683314_dp
+   ros_Gamma(3)= 0.21851380027664058511513169485832E+01_dp
+
+  END SUBROUTINE Ros3
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE Ros4
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     L-STABLE ROSENBROCK METHOD OF ORDER 4, WITH 4 STAGES
+!     L-STABLE EMBEDDED ROSENBROCK METHOD OF ORDER 3
+!
+!      E. HAIRER AND G. WANNER, SOLVING ORDINARY DIFFERENTIAL
+!      EQUATIONS II. STIFF AND DIFFERENTIAL-ALGEBRAIC PROBLEMS.
+!      SPRINGER SERIES IN COMPUTATIONAL MATHEMATICS,
+!      SPRINGER-VERLAG (1990)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+   IMPLICIT NONE
+
+   rosMethod = RS4
+!~~~> Name of the method
+   ros_Name = 'ROS-4'
+!~~~> Number of stages
+   ros_S = 4
+
+!~~~> The coefficient matrices A and C are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1), A(3,1)=ros_A(2), A(3,2)=ros_A(3), etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j )
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j )
+
+   ros_A(1) = 0.2000000000000000E+01_dp
+   ros_A(2) = 0.1867943637803922E+01_dp
+   ros_A(3) = 0.2344449711399156_dp
+   ros_A(4) = ros_A(2)
+   ros_A(5) = ros_A(3)
+   ros_A(6) = 0.0_dp
+
+   ros_C(1) =-0.7137615036412310E+01_dp
+   ros_C(2) = 0.2580708087951457E+01_dp
+   ros_C(3) = 0.6515950076447975_dp
+   ros_C(4) =-0.2137148994382534E+01_dp
+   ros_C(5) =-0.3214669691237626_dp
+   ros_C(6) =-0.6949742501781779_dp
+!~~~> Does the stage i require a new function evaluation (ros_NewF(i)=TRUE)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i)=FALSE)
+   ros_NewF(1)  = .TRUE.
+   ros_NewF(2)  = .TRUE.
+   ros_NewF(3)  = .TRUE.
+   ros_NewF(4)  = .FALSE.
+!~~~> M_i = Coefficients for new step solution
+   ros_M(1) = 0.2255570073418735E+01_dp
+   ros_M(2) = 0.2870493262186792_dp
+   ros_M(3) = 0.4353179431840180_dp
+   ros_M(4) = 0.1093502252409163E+01_dp
+!~~~> E_i  = Coefficients for error estimator
+   ros_E(1) =-0.2815431932141155_dp
+   ros_E(2) =-0.7276199124938920E-01_dp
+   ros_E(3) =-0.1082196201495311_dp
+   ros_E(4) =-0.1093502252409163E+01_dp
+!~~~> ros_ELO  = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus 1
+   ros_ELO  = 4.0_dp
+!~~~> Y_stage_i ~ Y( T + H*Alpha_i )
+   ros_Alpha(1) = 0.0_dp
+   ros_Alpha(2) = 0.1145640000000000E+01_dp
+   ros_Alpha(3) = 0.6552168638155900_dp
+   ros_Alpha(4) = ros_Alpha(3)
+!~~~> Gamma_i = \sum_j  gamma_{i,j}
+   ros_Gamma(1) = 0.5728200000000000_dp
+   ros_Gamma(2) =-0.1769193891319233E+01_dp
+   ros_Gamma(3) = 0.7592633437920482_dp
+   ros_Gamma(4) =-0.1049021087100450_dp
+
+  END SUBROUTINE Ros4
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE Rodas3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! --- A STIFFLY-STABLE METHOD, 4 stages, order 3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+   IMPLICIT NONE
+
+   rosMethod = RD3
+!~~~> Name of the method
+   ros_Name = 'RODAS-3'
+!~~~> Number of stages
+   ros_S = 4
+
+!~~~> The coefficient matrices A and C are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1), A(3,1)=ros_A(2), A(3,2)=ros_A(3), etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j )
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j )
+
+   ros_A(1) = 0.0_dp
+   ros_A(2) = 2.0_dp
+   ros_A(3) = 0.0_dp
+   ros_A(4) = 2.0_dp
+   ros_A(5) = 0.0_dp
+   ros_A(6) = 1.0_dp
+
+   ros_C(1) = 4.0_dp
+   ros_C(2) = 1.0_dp
+   ros_C(3) =-1.0_dp
+   ros_C(4) = 1.0_dp
+   ros_C(5) =-1.0_dp
+   ros_C(6) =-(8.0_dp/3.0_dp)
+
+!~~~> Does the stage i require a new function evaluation (ros_NewF(i)=TRUE)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i)=FALSE)
+   ros_NewF(1)  = .TRUE.
+   ros_NewF(2)  = .FALSE.
+   ros_NewF(3)  = .TRUE.
+   ros_NewF(4)  = .TRUE.
+!~~~> M_i = Coefficients for new step solution
+   ros_M(1) = 2.0_dp
+   ros_M(2) = 0.0_dp
+   ros_M(3) = 1.0_dp
+   ros_M(4) = 1.0_dp
+!~~~> E_i  = Coefficients for error estimator
+   ros_E(1) = 0.0_dp
+   ros_E(2) = 0.0_dp
+   ros_E(3) = 0.0_dp
+   ros_E(4) = 1.0_dp
+!~~~> ros_ELO  = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus 1
+   ros_ELO  = 3.0_dp
+!~~~> Y_stage_i ~ Y( T + H*Alpha_i )
+   ros_Alpha(1) = 0.0_dp
+   ros_Alpha(2) = 0.0_dp
+   ros_Alpha(3) = 1.0_dp
+   ros_Alpha(4) = 1.0_dp
+!~~~> Gamma_i = \sum_j  gamma_{i,j}
+   ros_Gamma(1) = 0.5_dp
+   ros_Gamma(2) = 1.5_dp
+   ros_Gamma(3) = 0.0_dp
+   ros_Gamma(4) = 0.0_dp
+
+  END SUBROUTINE Rodas3
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE Rodas4
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     STIFFLY-STABLE ROSENBROCK METHOD OF ORDER 4, WITH 6 STAGES
+!
+!      E. HAIRER AND G. WANNER, SOLVING ORDINARY DIFFERENTIAL
+!      EQUATIONS II. STIFF AND DIFFERENTIAL-ALGEBRAIC PROBLEMS.
+!      SPRINGER SERIES IN COMPUTATIONAL MATHEMATICS,
+!      SPRINGER-VERLAG (1996)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+   IMPLICIT NONE
+
+    rosMethod = RD4
+!~~~> Name of the method
+    ros_Name = 'RODAS-4'
+!~~~> Number of stages
+    ros_S = 6
+
+!~~~> Y_stage_i ~ Y( T + H*Alpha_i )
+    ros_Alpha(1) = 0.000_dp
+    ros_Alpha(2) = 0.386_dp
+    ros_Alpha(3) = 0.210_dp
+    ros_Alpha(4) = 0.630_dp
+    ros_Alpha(5) = 1.000_dp
+    ros_Alpha(6) = 1.000_dp
+
+!~~~> Gamma_i = \sum_j  gamma_{i,j}
+    ros_Gamma(1) = 0.2500000000000000_dp
+    ros_Gamma(2) =-0.1043000000000000_dp
+    ros_Gamma(3) = 0.1035000000000000_dp
+    ros_Gamma(4) =-0.3620000000000023E-01_dp
+    ros_Gamma(5) = 0.0_dp
+    ros_Gamma(6) = 0.0_dp
+
+!~~~> The coefficient matrices A and C are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1), A(3,1)=ros_A(2), A(3,2)=ros_A(3), etc.
+!   The general mapping formula is:  A(i,j) = ros_A( (i-1)*(i-2)/2 + j )
+!                  C(i,j) = ros_C( (i-1)*(i-2)/2 + j )
+
+    ros_A(1) = 0.1544000000000000E+01_dp
+    ros_A(2) = 0.9466785280815826_dp
+    ros_A(3) = 0.2557011698983284_dp
+    ros_A(4) = 0.3314825187068521E+01_dp
+    ros_A(5) = 0.2896124015972201E+01_dp
+    ros_A(6) = 0.9986419139977817_dp
+    ros_A(7) = 0.1221224509226641E+01_dp
+    ros_A(8) = 0.6019134481288629E+01_dp
+    ros_A(9) = 0.1253708332932087E+02_dp
+    ros_A(10) =-0.6878860361058950_dp
+    ros_A(11) = ros_A(7)
+    ros_A(12) = ros_A(8)
+    ros_A(13) = ros_A(9)
+    ros_A(14) = ros_A(10)
+    ros_A(15) = 1.0_dp
+
+    ros_C(1) =-0.5668800000000000E+01_dp
+    ros_C(2) =-0.2430093356833875E+01_dp
+    ros_C(3) =-0.2063599157091915_dp
+    ros_C(4) =-0.1073529058151375_dp
+    ros_C(5) =-0.9594562251023355E+01_dp
+    ros_C(6) =-0.2047028614809616E+02_dp
+    ros_C(7) = 0.7496443313967647E+01_dp
+    ros_C(8) =-0.1024680431464352E+02_dp
+    ros_C(9) =-0.3399990352819905E+02_dp
+    ros_C(10) = 0.1170890893206160E+02_dp
+    ros_C(11) = 0.8083246795921522E+01_dp
+    ros_C(12) =-0.7981132988064893E+01_dp
+    ros_C(13) =-0.3152159432874371E+02_dp
+    ros_C(14) = 0.1631930543123136E+02_dp
+    ros_C(15) =-0.6058818238834054E+01_dp
+
+!~~~> M_i = Coefficients for new step solution
+    ros_M(1) = ros_A(7)
+    ros_M(2) = ros_A(8)
+    ros_M(3) = ros_A(9)
+    ros_M(4) = ros_A(10)
+    ros_M(5) = 1.0_dp
+    ros_M(6) = 1.0_dp
+
+!~~~> E_i  = Coefficients for error estimator
+    ros_E(1) = 0.0_dp
+    ros_E(2) = 0.0_dp
+    ros_E(3) = 0.0_dp
+    ros_E(4) = 0.0_dp
+    ros_E(5) = 0.0_dp
+    ros_E(6) = 1.0_dp
+
+!~~~> Does the stage i require a new function evaluation (ros_NewF(i)=TRUE)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i)=FALSE)
+    ros_NewF(1) = .TRUE.
+    ros_NewF(2) = .TRUE.
+    ros_NewF(3) = .TRUE.
+    ros_NewF(4) = .TRUE.
+    ros_NewF(5) = .TRUE.
+    ros_NewF(6) = .TRUE.
+
+!~~~> ros_ELO  = estimator of local order - the minimum between the
+!        main and the embedded scheme orders plus 1
+    ros_ELO = 4.0_dp
+
+  END SUBROUTINE Rodas4
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE Rang3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! STIFFLY-STABLE W METHOD OF ORDER 3, WITH 4 STAGES
+!
+! J. RANG and L. ANGERMANN
+! NEW ROSENBROCK W-METHODS OF ORDER 3
+! FOR PARTIAL DIFFERENTIAL ALGEBRAIC
+!        EQUATIONS OF INDEX 1                                             
+! BIT Numerical Mathematics (2005) 45: 761-787
+!  DOI: 10.1007/s10543-005-0035-y
+! Table 4.1-4.2
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+   IMPLICIT NONE
+
+    rosMethod = RG3
+!~~~> Name of the method
+    ros_Name = 'RANG-3'
+!~~~> Number of stages
+    ros_S = 4
+
+    ros_A(1) = 5.09052051067020d+00;
+    ros_A(2) = 5.09052051067020d+00;
+    ros_A(3) = 0.0d0;
+    ros_A(4) = 4.97628111010787d+00;
+    ros_A(5) = 2.77268164715849d-02;
+    ros_A(6) = 2.29428036027904d-01;
+
+    ros_C(1) = -1.16790812312283d+01;
+    ros_C(2) = -1.64057326467367d+01;
+    ros_C(3) = -2.77268164715850d-01;
+    ros_C(4) = -8.38103960500476d+00;
+    ros_C(5) = -8.48328409199343d-01;
+    ros_C(6) =  2.87009860433106d-01;
+
+    ros_M(1) =  5.22582761233094d+00;
+    ros_M(2) = -5.56971148154165d-01;
+    ros_M(3) =  3.57979469353645d-01;
+    ros_M(4) =  1.72337398521064d+00;
+
+    ros_E(1) = -5.16845212784040d+00;
+    ros_E(2) = -1.26351942603842d+00;
+    ros_E(3) = -1.11022302462516d-16;
+    ros_E(4) =  2.22044604925031d-16;
+
+    ros_Alpha(1) = 0.0d00;
+    ros_Alpha(2) = 2.21878746765329d+00;
+    ros_Alpha(3) = 2.21878746765329d+00;
+    ros_Alpha(4) = 1.55392337535788d+00;
+
+    ros_Gamma(1) =  4.35866521508459d-01;
+    ros_Gamma(2) = -1.78292094614483d+00;
+    ros_Gamma(3) = -2.46541900496934d+00;
+    ros_Gamma(4) = -8.05529997906370d-01;
+
+
+!~~~> Does the stage i require a new function evaluation (ros_NewF(i)=TRUE)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i)=FALSE)
+    ros_NewF(1) = .TRUE.
+    ros_NewF(2) = .TRUE.
+    ros_NewF(3) = .TRUE.
+    ros_NewF(4) = .TRUE.
+
+!~~~> ros_ELO  = estimator of local order - the minimum between the
+!        main and the embedded scheme orders plus 1
+    ros_ELO = 3.0_dp
+
+  END SUBROUTINE Rang3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!   End of the set of internal Rosenbrock subroutines
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END SUBROUTINE Rosenbrock
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/templates/initialize_kpp_ctrl_template.f90
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/templates/initialize_kpp_ctrl_template.f90	(revision 3297)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/templates/initialize_kpp_ctrl_template.f90	(revision 3298)
@@ -32,5 +32,5 @@
 CONTAINS
 
-SUBROUTINE initialize_kpp_ctrl(status, iou, modstr)
+SUBROUTINE initialize_kpp_ctrl(status)
 
   IMPLICIT NONE
@@ -38,6 +38,4 @@
   ! I/O
   INTEGER,          INTENT(OUT) :: status
-  INTEGER,          INTENT(IN)  :: iou     ! logical I/O unit
-  CHARACTER(LEN=*), INTENT(IN)  :: modstr  ! read <modstr>.nml
 
   ! LOCAL
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/templates/module_header
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/templates/module_header	(revision 3297)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/templates/module_header	(revision 3298)
@@ -3,5 +3,22 @@
 ! ****** Module chem_gasphase_mod is automatically generated by kpp4palm ******
 !
-!           ********* Please do NOT change this Code *********
+!   ********* Please do NOT change this Code, it will be ovewritten *********
+!
+!------------------------------------------------------------------------------!
+! This file was created by KPP (http://people.cs.vt.edu/asandu/Software/Kpp/)
+! and kpp4palm (created by Klaus Ketelsen). kpp4palm is an adapted version 
+! of KP4 (JÃ¶ckel, P., Kerkweg, A., Pozzer, A., Sander, R., Tost, H., Riede, 
+! H., Baumgaertner, A., Gromov, S., and Kern, B., 2010: Development cycle 2 of
+! the Modular Earth Submodel System (MESSy2), Geosci. Model Dev., 3, 717-752, 
+! https://doi.org/10.5194/gmd-3-717-2010). KP4 is part of the Modular Earth 
+! Submodel System (MESSy), which is is available under the  GNU General Public 
+! License (GPL).
+!
+! KPP is free software; you can redistribute it and/or modify it under the terms 
+! of the General Public Licence as published by the Free Software Foundation; 
+! either version 2 of the License, or (at your option) any later version. 
+! KPP is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; 
+! without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 
+! PURPOSE. See the GNU General Public Licence for more details. 
 !
 !------------------------------------------------------------------------------!
@@ -30,10 +47,11 @@
 ! -----------------
 ! $Id: module_header 2460 2017-09-13 14:47:48Z forkel $
+! forkel June 2018: qvap, fakt added
+! forkel June 2018: reset case in  Initialize, Integrate, Update_rconst
+! 
+! 
+! 2460 2017-09-13 14:47:48Z forkel
 !
-! 
-! Variables for photolyis added
-!
-!
-!
+! forkel Sept. 2017: Variables for photolyis added
 !
 !
@@ -64,10 +82,13 @@
   PUBLIC :: nspec, nreact
   PUBLIC :: temp
+  PUBLIC :: qvap
+  PUBLIC :: fakt
   PUBLIC :: phot 
   PUBLIC :: rconst
   PUBLIC :: nvar
   PUBLIC :: nphot
+  PUBLIC :: vl_dim                     ! Public to ebable other modules to distiguish between scalar and vec
  
-  PUBLIC :: initialize, integrate, update_rconst
+  PUBLIC :: Initialize, Integrate, Update_rconst
   PUBLIC :: chem_gasphase_integrate
   PUBLIC :: initialize_kpp_ctrl
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/templates/rosenbrock_vec.f90
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/templates/rosenbrock_vec.f90	(revision 3297)
+++ 	(revision )
@@ -1,1161 +1,0 @@
-! NOTE: This routine is a vectorised version of the routine in
-!       rosenbrock_mz.f90 and can only be used with KP4.
-!
-SUBROUTINE Rosenbrock(Y,Tstart,Tend, &
-           AbsTol,RelTol,            &
-           RCNTRL,ICNTRL,RSTATUS,ISTATUS,IERR)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!
-!    Solves the system y'=F(t,y) using a Rosenbrock method defined by:
-!
-!     G = 1/(H*gamma(1)) - Jac(t0,Y0)
-!     T_i = t0 + Alpha(i)*H
-!     Y_i = Y0 + \sum_{j=1}^{i-1} A(i,j)*K_j
-!     G * K_i = Fun( T_i, Y_i ) + \sum_{j=1}^S C(i,j)/H * K_j +
-!         gamma(i)*dF/dT(t0, Y0)
-!     Y1 = Y0 + \sum_{j=1}^S M(j)*K_j
-!
-!    For details on Rosenbrock methods and their implementation consult:
-!      E. Hairer and G. Wanner
-!      "Solving ODEs II. Stiff and differential-algebraic problems".
-!      Springer series in computational mathematics, Springer-Verlag, 1996.
-!    The codes contained in the book inspired this implementation.
-!
-!    (C)  Adrian Sandu, August 2004
-!    Virginia Polytechnic Institute and State University
-!    Contact: sandu@cs.vt.edu
-!    This implementation is part of KPP - the Kinetic PreProcessor
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!
-!~~~>   INPUT ARGUMENTS:
-!
-!-     Y(NVAR)    = vector of initial conditions (at T=Tstart)
-!-    [Tstart,Tend]  = time range of integration
-!     (if Tstart>Tend the integration is performed backwards in time)
-!-    RelTol, AbsTol = user precribed accuracy
-!- SUBROUTINE  Fun( T, Y, Ydot ) = ODE function,
-!                       returns Ydot = Y' = F(T,Y)
-!- SUBROUTINE  Jac( T, Y, Jcb ) = Jacobian of the ODE function,
-!                       returns Jcb = dFun/dY
-!-    ICNTRL(1:20)    = integer inputs parameters
-!-    RCNTRL(1:20)    = real inputs parameters
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!
-!~~~>     OUTPUT ARGUMENTS:
-!
-!-    Y(NVAR)    -> vector of final states (at T->Tend)
-!-    ISTATUS(1:20)   -> integer output parameters
-!-    RSTATUS(1:20)   -> real output parameters
-!-    IERR            -> job status upon return
-!                        success (positive value) or
-!                        failure (negative value)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!
-!~~~>     INPUT PARAMETERS:
-!
-!    Note: For input parameters equal to zero the default values of the
-!       corresponding variables are used.
-!
-!    ICNTRL(1) = 1: F = F(y)   Independent of T (AUTONOMOUS)
-!              = 0: F = F(t,y) Depends on T (NON-AUTONOMOUS)
-!
-!    ICNTRL(2) = 0: AbsTol, RelTol are NVAR-dimensional vectors
-!              = 1: AbsTol, RelTol are scalars
-!
-!    ICNTRL(3)  -> selection of a particular Rosenbrock method
-!        = 0 :  default method is Rodas3
-!        = 1 :  method is  Ros2
-!        = 2 :  method is  Ros3
-!        = 3 :  method is  Ros4
-!        = 4 :  method is  Rodas3
-!        = 5:   method is  Rodas4
-!
-!    ICNTRL(4)  -> maximum number of integration steps
-!        For ICNTRL(4)=0) the default value of 100000 is used
-!
-!    RCNTRL(1)  -> Hmin, lower bound for the integration step size
-!          It is strongly recommended to keep Hmin = ZERO
-!    RCNTRL(2)  -> Hmax, upper bound for the integration step size
-!    RCNTRL(3)  -> Hstart, starting value for the integration step size
-!
-!    RCNTRL(4)  -> FacMin, lower bound on step decrease factor (default=0.2)
-!    RCNTRL(5)  -> FacMax, upper bound on step increase factor (default=6)
-!    RCNTRL(6)  -> FacRej, step decrease factor after multiple rejections
-!            (default=0.1)
-!    RCNTRL(7)  -> FacSafe, by which the new step is slightly smaller
-!         than the predicted value  (default=0.9)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!
-!~~~>     OUTPUT PARAMETERS:
-!
-!    Note: each call to Rosenbrock adds the current no. of fcn calls
-!      to previous value of ISTATUS(1), and similar for the other params.
-!      Set ISTATUS(1:20) = 0 before call to avoid this accumulation.
-!
-!    ISTATUS(1) = No. of function calls
-!    ISTATUS(2) = No. of jacobian calls
-!    ISTATUS(3) = No. of steps
-!    ISTATUS(4) = No. of accepted steps
-!    ISTATUS(5) = No. of rejected steps (except at the beginning)
-!    ISTATUS(6) = No. of LU decompositions
-!    ISTATUS(7) = No. of forward/backward substitutions
-!    ISTATUS(8) = No. of singular matrix decompositions
-!
-!    RSTATUS(1)  -> Texit, the time corresponding to the
-!                   computed Y upon return
-!    RSTATUS(2)  -> Hexit, last accepted step before exit
-!    For multiple restarts, use Hexit as Hstart in the following run
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-  IMPLICIT NONE
-
-!~~~>  Arguments
-   REAL(kind=dp), INTENT(INOUT) :: Y(:,:)
-   REAL(kind=dp), INTENT(IN)   :: Tstart,Tend
-   REAL(kind=dp), INTENT(IN)   :: AbsTol(NVAR),RelTol(NVAR)
-   INTEGER, INTENT(IN)    :: ICNTRL(20)
-   REAL(kind=dp), INTENT(IN)   :: RCNTRL(20)
-   INTEGER, INTENT(INOUT) :: ISTATUS(20)
-   REAL(kind=dp), INTENT(INOUT) :: RSTATUS(20)
-   INTEGER, INTENT(OUT)   :: IERR
-!~~~>  The method parameters
-   INTEGER, PARAMETER :: Smax = 6
-   INTEGER  :: Method, ros_S
-   REAL(kind=dp), DIMENSION(Smax) :: ros_M, ros_E, ros_Alpha, ros_Gamma
-   REAL(kind=dp), DIMENSION(Smax*(Smax-1)/2) :: ros_A, ros_C
-   REAL(kind=dp) :: ros_ELO
-   LOGICAL, DIMENSION(Smax) :: ros_NewF
-   CHARACTER(LEN=12) :: ros_Name
-!~~~>  Local variables
-   REAL(kind=dp) :: Roundoff, FacMin, FacMax, FacRej, FacSafe
-   REAL(kind=dp) :: Hmin, Hmax, Hstart, Hexit
-   REAL(kind=dp) :: Texit
-   INTEGER :: i, UplimTol, Max_no_steps
-   LOGICAL :: Autonomous, VectorTol
-!~~~>   Parameters
-   REAL(kind=dp), PARAMETER :: ZERO = 0.0_dp, ONE  = 1.0_dp
-   REAL(kind=dp), PARAMETER :: DeltaMin = 1.0E-5_dp
-
-!~~~>  Initialize statistics
-   Nfun = ISTATUS(ifun)
-   Njac = ISTATUS(ijac)
-   Nstp = ISTATUS(istp)
-   Nacc = ISTATUS(iacc)
-   Nrej = ISTATUS(irej)
-   Ndec = ISTATUS(idec)
-   Nsol = ISTATUS(isol)
-   Nsng = ISTATUS(isng)
-
-!~~~>  Autonomous or time dependent ODE. Default is time dependent.
-   Autonomous = .NOT.(ICNTRL(1) == 0)
-
-!~~~>  For Scalar tolerances (ICNTRL(2).NE.0)  the code uses AbsTol(1) and RelTol(1)
-!   For Vector tolerances (ICNTRL(2) == 0) the code uses AbsTol(1:NVAR) and RelTol(1:NVAR)
-   IF (ICNTRL(2) == 0) THEN
-      VectorTol = .TRUE.
-         UplimTol  = NVAR
-   ELSE
-      VectorTol = .FALSE.
-         UplimTol  = 1
-   END IF
-
-!~~~>  The particular Rosenbrock method chosen
-   IF (ICNTRL(3) == 0) THEN
-      Method = 4
-   ELSEIF ( (ICNTRL(3) >= 1).AND.(ICNTRL(3) <= 5) ) THEN
-      Method = ICNTRL(3)
-   ELSE
-      PRINT * , 'User-selected Rosenbrock method: ICNTRL(3)=', Method
-      !CALL ros_ErrorMsg(-2,Tstart,ZERO,IERR)
-      IERRV(:) = -2
-      RETURN
-   END IF
-
-!~~~>   The maximum number of steps admitted
-   IF (ICNTRL(4) == 0) THEN
-      Max_no_steps = 100000 ! 200
-   ELSEIF (ICNTRL(4) > 0) THEN
-      Max_no_steps=ICNTRL(4)
-   ELSE
-      PRINT * ,'User-selected max no. of steps: ICNTRL(4)=',ICNTRL(4)
-      !CALL ros_ErrorMsg(-1,Tstart,ZERO,IERR)
-      IERRV(:) = -1
-      RETURN
-   END IF
-
-!~~~>  Unit roundoff (1+Roundoff>1)
-   Roundoff = WLAMCH('E')
-
-!~~~>  Lower bound on the step size: (positive value)
-   IF (RCNTRL(1) == ZERO) THEN
-      Hmin = ZERO
-   ELSEIF (RCNTRL(1) > ZERO) THEN
-      Hmin = RCNTRL(1)
-   ELSE
-      PRINT * , 'User-selected Hmin: RCNTRL(1)=', RCNTRL(1)
-      !CALL ros_ErrorMsg(-3,Tstart,ZERO,IERR)
-      IERRV(:) = -3
-      RETURN
-   END IF
-!~~~>  Upper bound on the step size: (positive value)
-   IF (RCNTRL(2) == ZERO) THEN
-      Hmax = ABS(Tend-Tstart)
-   ELSEIF (RCNTRL(2) > ZERO) THEN
-      Hmax = MIN(ABS(RCNTRL(2)),ABS(Tend-Tstart))
-   ELSE
-      PRINT * , 'User-selected Hmax: RCNTRL(2)=', RCNTRL(2)
-      !CALL ros_ErrorMsg(-3,Tstart,ZERO,IERR)
-      IERRV(:) = -3
-      RETURN
-   END IF
-!~~~>  Starting step size: (positive value)
-   IF (RCNTRL(3) == ZERO) THEN
-      Hstart = MAX(Hmin,DeltaMin)
-   ELSEIF (RCNTRL(3) > ZERO) THEN
-      Hstart = MIN(ABS(RCNTRL(3)),ABS(Tend-Tstart))
-   ELSE
-      PRINT * , 'User-selected Hstart: RCNTRL(3)=', RCNTRL(3)
-      !CALL ros_ErrorMsg(-3,Tstart,ZERO,IERR)
-      IERRV(:) = -3
-      RETURN
-   END IF
-!~~~>  Step size can be changed s.t.  FacMin < Hnew/Hexit < FacMax
-   IF (RCNTRL(4) == ZERO) THEN
-      FacMin = 0.2_dp
-   ELSEIF (RCNTRL(4) > ZERO) THEN
-      FacMin = RCNTRL(4)
-   ELSE
-      PRINT * , 'User-selected FacMin: RCNTRL(4)=', RCNTRL(4)
-      !CALL ros_ErrorMsg(-4,Tstart,ZERO,IERR)
-      IERRV(:) = -4
-      RETURN
-   END IF
-   IF (RCNTRL(5) == ZERO) THEN
-      FacMax = 6.0_dp
-   ELSEIF (RCNTRL(5) > ZERO) THEN
-      FacMax = RCNTRL(5)
-   ELSE
-      PRINT * , 'User-selected FacMax: RCNTRL(5)=', RCNTRL(5)
-      !CALL ros_ErrorMsg(-4,Tstart,ZERO,IERR)
-      IERRV(:) = -4
-      RETURN
-   END IF
-!~~~>   FacRej: Factor to decrease step after 2 succesive rejections
-   IF (RCNTRL(6) == ZERO) THEN
-      FacRej = 0.1_dp
-   ELSEIF (RCNTRL(6) > ZERO) THEN
-      FacRej = RCNTRL(6)
-   ELSE
-      PRINT * , 'User-selected FacRej: RCNTRL(6)=', RCNTRL(6)
-      !CALL ros_ErrorMsg(-4,Tstart,ZERO,IERR)
-      IERRV(:) = -4
-      RETURN
-   END IF
-!~~~>   FacSafe: Safety Factor in the computation of new step size
-   IF (RCNTRL(7) == ZERO) THEN
-      FacSafe = 0.9_dp
-   ELSEIF (RCNTRL(7) > ZERO) THEN
-      FacSafe = RCNTRL(7)
-   ELSE
-      PRINT * , 'User-selected FacSafe: RCNTRL(7)=', RCNTRL(7)
-      !CALL ros_ErrorMsg(-4,Tstart,ZERO,IERR)
-      IERRV(:) = -4
-      RETURN
-   END IF
-!~~~>  Check if tolerances are reasonable
-    DO i=1,UplimTol
-      IF ( (AbsTol(i) <= ZERO) .OR. (RelTol(i) <= 10.0_dp*Roundoff) &
-         .OR. (RelTol(i) >= 1.0_dp) ) THEN
-        PRINT * , ' AbsTol(',i,') = ',AbsTol(i)
-        PRINT * , ' RelTol(',i,') = ',RelTol(i)
-        !CALL ros_ErrorMsg(-5,Tstart,ZERO,IERR)
-        IERRV(:) = -5
-        RETURN
-      END IF
-    END DO
-
-
-!~~~>   Initialize the particular Rosenbrock method
-   SELECT CASE (Method)
-     CASE (1)
-       CALL Ros2(ros_S, ros_A, ros_C, ros_M, ros_E,   &
-          ros_Alpha, ros_Gamma, ros_NewF, ros_ELO, ros_Name)
-     CASE (2)
-       CALL Ros3(ros_S, ros_A, ros_C, ros_M, ros_E,   &
-          ros_Alpha, ros_Gamma, ros_NewF, ros_ELO, ros_Name)
-     CASE (3)
-       CALL Ros4(ros_S, ros_A, ros_C, ros_M, ros_E,   &
-          ros_Alpha, ros_Gamma, ros_NewF, ros_ELO, ros_Name)
-     CASE (4)
-       CALL Rodas3(ros_S, ros_A, ros_C, ros_M, ros_E, &
-          ros_Alpha, ros_Gamma, ros_NewF, ros_ELO, ros_Name)
-     CASE (5)
-       CALL Rodas4(ros_S, ros_A, ros_C, ros_M, ros_E, &
-          ros_Alpha, ros_Gamma, ros_NewF, ros_ELO, ros_Name)
-     CASE DEFAULT
-       PRINT * , 'Unknown Rosenbrock method: ICNTRL(3)=', Method
-       !CALL ros_ErrorMsg(-2,Tstart,ZERO,IERR)
-       IERRV(:) = -2
-       RETURN
-   END SELECT
-
-!~~~>  CALL Rosenbrock method
-   CALL ros_Integrator(Y,Tstart,Tend,Texit,      &
-        AbsTol, RelTol,                          &
-!  Rosenbrock method coefficients
-        ros_S, ros_M, ros_E, ros_A, ros_C,       &
-        ros_Alpha, ros_Gamma, ros_ELO, ros_NewF, &
-!  Integration parameters
-        Autonomous, VectorTol, Max_no_steps,     &
-        Roundoff, Hmin, Hmax, Hstart, Hexit,     &
-        FacMin, FacMax, FacRej, FacSafe,         &
-!  Error indicator
-        IERR)
-
-
-!~~~>  Collect run statistics
-   ISTATUS(ifun) = Nfun
-   ISTATUS(ijac) = Njac
-   ISTATUS(istp) = Nstp
-   ISTATUS(iacc) = Nacc
-   ISTATUS(irej) = Nrej
-   ISTATUS(idec) = Ndec
-   ISTATUS(isol) = Nsol
-   ISTATUS(isng) = Nsng
-!~~~> Last T and H
-   RSTATUS(itexit) = Texit
-   RSTATUS(ihexit) = Hexit
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-CONTAINS !  SUBROUTINES internal to Rosenbrock
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- SUBROUTINE ros_ErrorMsg(Code,T,H,IERR)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!    Handles all error messages
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-   REAL(kind=dp), INTENT(IN) :: T, H
-   INTEGER, INTENT(IN)  :: Code
-   INTEGER, INTENT(INOUT) :: IERR
-
-   IERR = Code
-   PRINT * , &
-     'Forced exit from Rosenbrock due to the following error:'
-   IF ((Code>=-8).AND.(Code<=-1)) THEN
-     PRINT *, IERR_NAMES(Code)
-   ELSE
-     PRINT *, 'Unknown Error code: ', Code
-   ENDIF
-
-   PRINT *, "T=", T, "and H=", H
-
- END SUBROUTINE ros_ErrorMsg
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- SUBROUTINE ros_Integrator (Y, Tstart, Tend, Tout,     &
-        AbsTol, RelTol,                          &
-!~~~> Rosenbrock method coefficients
-        ros_S, ros_M, ros_E, ros_A, ros_C,       &
-        ros_Alpha, ros_Gamma, ros_ELO, ros_NewF, &
-!~~~> Integration parameters
-        Autonomous, VectorTol, Max_no_steps,     &
-        Roundoff, Hmin, Hmax, Hstart, Hexit,     &
-        FacMin, FacMax, FacRej, FacSafe,         &
-!~~~> Error indicator
-        IERR )
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!   Template for the implementation of a generic Rosenbrock method
-!      defined by ros_S (no of stages)
-!      and its coefficients ros_{A,C,M,E,Alpha,Gamma}
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-  USE messy_main_tools_kp4_compress, ONLY: kco_initialize, kco_compress, &
-                                           kco_finalize, cell_done
-  IMPLICIT NONE
-
-!~~~> Input: the initial condition at Tstart; Output: the solution at T
-   REAL(kind=dp), INTENT(INOUT) :: Y(:,:)
-!~~~> Input: integration interval
-   REAL(kind=dp), INTENT(IN) :: Tstart,Tend
-!~~~> Output: time at which the solution is returned (T=Tend if success)
-   REAL(kind=dp), INTENT(OUT) ::  Tout
-!~~~> Input: tolerances
-   REAL(kind=dp), INTENT(IN) ::  AbsTol(NVAR), RelTol(NVAR)
-!~~~> Input: The Rosenbrock method parameters
-   INTEGER, INTENT(IN) ::  ros_S
-   REAL(kind=dp), INTENT(IN) :: ros_M(ros_S), ros_E(ros_S),  &
-       ros_Alpha(ros_S), ros_A(ros_S*(ros_S-1)/2), &
-       ros_Gamma(ros_S), ros_C(ros_S*(ros_S-1)/2), ros_ELO
-   LOGICAL, INTENT(IN) :: ros_NewF(ros_S)
-!~~~> Input: integration parameters
-   LOGICAL, INTENT(IN) :: Autonomous, VectorTol
-   REAL(kind=dp), INTENT(IN) :: Hstart, Hmin, Hmax
-   INTEGER, INTENT(IN) :: Max_no_steps
-   REAL(kind=dp), INTENT(IN) :: Roundoff, FacMin, FacMax, FacRej, FacSafe
-!~~~> Output: last accepted step
-   REAL(kind=dp), INTENT(OUT) :: Hexit
-!~~~> Output: Error indicator
-   INTEGER, INTENT(OUT) :: IERR
-! ~~~~ Local variables
-   REAL(kind=dp) :: Ynew(VL_DIM,NVAR), Fcn0(VL_DIM,NVAR), Fcn(VL_DIM,NVAR)
-   REAL(kind=dp) :: K(VL_DIM,NVAR*ros_S)
-   REAL(kind=dp) :: Jac0(VL_DIM,LU_NONZERO), Ghimj(VL_DIM,LU_NONZERO)
-   REAL(kind=dp) :: Yerr(VL_DIM,NVAR)
-
-!~~~>  Local parameters
-   INTEGER :: ioffset, i, j, istage
-   REAL(kind=dp), PARAMETER :: ZERO = 0.0_dp, ONE  = 1.0_dp
-   REAL(kind=dp), PARAMETER :: DeltaMin = 1.0E-5_dp
-!~~~>  Locally called functions
-!    REAL(kind=dp) WLAMCH
-!    EXTERNAL WLAMCH
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-   real(kind=dp)                  :: deltat
-!kk   logical,parameter              :: fixed_step=.true.
-   
-   integer,save             :: icount=0
-
-!  vector compression algorithm
-
-   REAL(kind=dp), dimension(VL_dim)      :: T
-   REAL(kind=dp), dimension(VL_dim)      :: H, Hnew, HC, HC2, HG, Fac, Tau, Err
-   LOGICAL, dimension(VL_dim)            :: RejectLastH, RejectMoreH
-   LOGICAL, dimension(VL_dim)            :: Accept_step
-   integer                               :: vl_save
-
-   REAL(kind=dp), dimension(size(FIX,1),size(FIX,2))      :: FIX_lo
-
-!~~~>  Initial preparations
-   T(1:VL)  = Tstart
-   Hexit    = 0.0_dp
-   H(1:VL)  = MIN(Hstart,Hmax)
-   Tout     = Tend
-   icount   = icount+1
-   where (ABS(H(1:VL)) <= 10.0_dp*Roundoff) H(1:VL) = DeltaMin
-
-   deltat=Tend-Tstart
-
-   RejectLastH(1:VL)=.FALSE.
-   RejectMoreH(1:VL)=.FALSE.
-
-!~~~> Time loop begins below
-
-   Nstp       = 0
-   IERRV(1:VL) = 1  ! successful integration
-   vl_save          = VL
-   FIX_lo(1:VL,:)   = FIX(1:VL,:)
-   Kacc(1:VL)       = 0
-   Krej(1:VL)       = 0
-
-!  intialize compression algorithm
-
-   IF (.not. l_fixed_step) then
-      call kco_initialize (VL, y, IERRV, Kacc, Krej)
-   end if
-
-TimeLoop: DO 
-
-   IF ( Nstp > Max_no_steps ) THEN  ! Too many steps
-      !CALL ros_ErrorMsg(-6,T(1),H(1),IERR)
-      IERRV(1:VL) = -6
-!      call abort()                                   !Vorlaeufig
-      RETURN
-   END IF
-   
-   Where ( (T(1:VL)+0.1_dp*H(1:VL)) == T(1:VL))      ! Step size too small
-      IERRV(1:VL) = -7
-   endwhere
-
-!!$   if( any(error_flag))  then
-!!$      CALL ros_ErrorMsg(-7,T(1),H(1),IERR)
-!!$      call abort()                                   !Vorlaeufig
-!!$      RETURN
-!!$   end if
-
-!~~~>  Limit H if necessary to avoid going beyond Tend
-!kk   Hexit = H
-   H(1:VL) = MIN(H(1:VL),ABS(Tend-T(1:VL)))
-
-!~~~>   Compute the function at current time
-   CALL Fun( Y, FIX_lo, RCONST, Fcn0)
-
-
-!~~~>   Compute the Jacobian at current time
-   CALL Jac_SP( Y, FIX_lo, RCONST, Jac0)
-
-
-!~~~>  Repeat step calculation until current step accepted
-
-   CALL ros_PrepareMatrix(H,ros_Gamma(1), Jac0,Ghimj)
-
-!~~~>   Compute the stages
-Stage: DO istage = 1, ros_S
-
-      ! Current istage offset. Current istage vector is K(ioffset+1:ioffset+NVAR)
-       ioffset = NVAR*(istage-1)
-
-      ! For the 1st istage the function has been computed previously
-       IF ( istage == 1 ) THEN
-         Fcn(1:VL,1:NVAR) = Fcn0(1:VL,1:NVAR) 
-      ! istage>1 and a new function evaluation is needed at the current istage
-       ELSEIF ( ros_NewF(istage) ) THEN
-         select case (istage-1)
-          case (1)
-           Ynew(1:VL,1:NVAR) = Y(1:VL,1:NVAR)
-           Ynew(1:VL,1:NVAR) = Ynew(1:VL,1:NVAR) +  K(1:VL,NVAR*(1- 1)+ 1:NVAR*1) &
-                        *ros_A((istage-1)*(istage-2)/2+ 1)
-          case (2)
-           Ynew(1:VL,1:NVAR) = Y(1:VL,1:NVAR)
-           Ynew(1:VL,1:NVAR) = Ynew(1:VL,1:NVAR) +  K(1:VL,NVAR*(2- 1)+ 1:NVAR*2) &
-                        *ros_A((istage-1)*(istage-2)/2+ 2)
-           Ynew(1:VL,1:NVAR) = Ynew(1:VL,1:NVAR) +  K(1:VL,NVAR*(2- 1)+ 1:NVAR*2) &
-                        *ros_A((istage-1)*(istage-2)/2+ 2)
-          case DEFAULT
-           Ynew(1:VL,1:NVAR) = Y(1:VL,1:NVAR)
-           DO j = 1, istage-1
-             Ynew(1:VL,1:NVAR) = Ynew(1:VL,1:NVAR) +  K(1:VL,NVAR*(j- 1)+ 1:NVAR*j) &
-                          *ros_A((istage-1)*(istage-2)/2+ j)
-           END DO
-         end select
-
-         CALL Fun( Ynew, FIX_lo, RCONST, Fcn)
-       END IF ! if istage == 1 elseif ros_NewF(istage)
-
-       select case (istage-1)
-        case (1)
-         K(1:VL,ioffset+ 1:ioffset+ NVAR) = Fcn(1:VL,1:NVAR)
-         j = 1
-         HC(1:VL) = ros_C((istage-1)*(istage-2)/2+ j)/(H(1:VL))
-         do i=1,NVAR
-           K(1:VL,ioffset+ i) = K(1:VL,ioffset+ i) +  K(1:VL,NVAR*(j- 1)+ i) *HC(1:VL)
-         end do
-        case (2)
-         K(1:VL,ioffset+ 1:ioffset+ NVAR) = Fcn(1:VL,1:NVAR)
-         HC(1:VL)  = ros_C((istage-1)*(istage-2)/2+ 1)/(H(1:VL))
-         HC2(1:VL) = ros_C((istage-1)*(istage-2)/2+ 2)/(H(1:VL))
-         do i=1,NVAR
-           K(1:VL,ioffset+ i) = K(1:VL,ioffset+ i) +  K(1:VL,NVAR*(1- 1)+ i) *HC(1:VL)
-           K(1:VL,ioffset+ i) = K(1:VL,ioffset+ i) +  K(1:VL,NVAR*(2- 1)+ i) *HC2(1:VL)
-         end do
-        case DEFAULT
-         K(1:VL,ioffset+ 1:ioffset+ NVAR) = Fcn(1:VL,1:NVAR)
-         DO j = 1, istage-1
-           HC(1:VL) = ros_C((istage-1)*(istage-2)/2+ j)/(H(1:VL))
-           do i=1,NVAR
-             K(1:VL,ioffset+ i) = K(1:VL,ioffset+ i) +  K(1:VL,NVAR*(j- 1)+ i) *HC(1:VL)
-           end do
-         END DO
-       end select
-
-       CALL ros_Solve(Ghimj, K(:,ioffset+1:ioffset+NVAR))
-
-   END DO Stage
-
-
-   if(ros_S == 3)   then
-     YNEW(1:VL,1:NVAR) = Y(1:VL,1:NVAR)
-     Yerr(1:VL,1:NVAR) = ZERO
-
-!~~~>  Compute the new solution
-     Ynew(1:VL,1:NVAR) = Ynew(1:VL,1:NVAR) + K(1:VL,NVAR*(1-1)+1:NVAR*1) * ros_m(1)
-     Ynew(1:VL,1:NVAR) = Ynew(1:VL,1:NVAR) + K(1:VL,NVAR*(2-1)+1:NVAR*2) * ros_m(2)
-     Ynew(1:VL,1:NVAR) = Ynew(1:VL,1:NVAR) + K(1:VL,NVAR*(3-1)+1:NVAR*3) * ros_m(3)
-
-!~~~>  Compute the error estimation
-
-     Yerr(1:VL,1:NVAR) = Yerr(1:VL,1:NVAR) + K(1:VL,NVAR*(1-1)+1:NVAR*1) * ros_E(1)
-     Yerr(1:VL,1:NVAR) = Yerr(1:VL,1:NVAR) + K(1:VL,NVAR*(2-1)+1:NVAR*2) * ros_E(2)
-     Yerr(1:VL,1:NVAR) = Yerr(1:VL,1:NVAR) + K(1:VL,NVAR*(3-1)+1:NVAR*3) * ros_E(3)
-   else
-     YNEW(1:VL,1:NVAR) = Y(1:VL,1:NVAR)
-     Yerr(1:VL,1:NVAR) = ZERO
-     DO j=1,ros_S
-!~~~>  Compute the new solution
-         Ynew(1:VL,1:NVAR) = Ynew(1:VL,1:NVAR) + &
-                        K(1:VL,NVAR*(j-1)+1:NVAR*j) * ros_m(j)
-
-!~~~>  Compute the error estimation
-
-       Yerr(1:VL,1:NVAR) = Yerr(1:VL,1:NVAR) + &
-                    K(1:VL,NVAR*(j-1)+1:NVAR*j) * ros_E(j)
-     END DO
-   end if
-
-
-!~~~>  Check the error magnitude and adjust step size
-   Nstp = Nstp+1
-
-   if(l_fixed_step)   then
-     Err  = 0.0
-     H    = t_steps(Nstp)*deltat
-     Hnew = t_steps(Nstp)*deltat
-   else
-     Err(1:VL) = ros_ErrorNorm ( Y, Ynew, Yerr, AbsTol, RelTol, VectorTol )
-!~~~> New step size is bounded by FacMin <= Hnew/H <= FacMax
-     where(Err(1:VL) >= 10.0_dp*Roundoff)
-       Fac(1:VL)  = MIN(FacMax,MAX(FacMin,FacSafe/Err(1:VL)**(ONE/ros_ELO)))
-     elsewhere
-       Fac(1:VL)  = 1000.                        !Force large time step
-     endwhere
-     Hnew(1:VL) = H(1:VL)*Fac(1:VL)
-   end if
-
-   Accept_step(1:VL) = (Err(1:VL) <= ONE).OR.(H(1:VL) <= Hmin)
-   where (Accept_step(1:VL))
-      Kacc(1:VL) = Kacc(1:VL)+1
-      T(1:VL) = T(1:VL) + H(1:VL)
-      Hnew(1:VL) = MAX(Hmin,MIN(Hnew(1:VL),Hmax))
-   endwhere
-   do i=1,NVAR
-     where (Accept_step(1:VL))
-       Y(1:VL,i) = MAX(Ynew(1:VL,i),ZERO)
-     endwhere
-   end do
-   where (Accept_step(1:VL) .and. RejectLastH(1:VL))
-      Hnew(1:VL) = MIN(Hnew(1:VL),H(1:VL))
-   endwhere
-   where (Accept_step(1:VL))
-      RejectLastH(1:VL) = .FALSE.
-      RejectMoreH(1:VL) = .FALSE.
-      H(1:VL) = Hnew(1:VL)
-   endwhere
-!kk   ELSE           !~~~> Reject step
-   where (.NOT. Accept_step(1:VL) .and. RejectMoreH(1:VL))
-      Hnew(1:VL) = H(1:VL)*FacRej
-   endwhere
-   where (.NOT. Accept_step(1:VL))
-      RejectMoreH(1:VL) = RejectLastH(1:VL)
-      RejectLastH(1:VL) = .TRUE.
-      H(1:VL) = Hnew(1:VL)
-   endwhere
-   where ( .NOT. Accept_step(1:VL) .and. Kacc(1:VL) >= 1)
-      Krej(1:VL) = Krej(1:VL)+1
-   endwhere
-
-
-   if(l_fixed_step)   then
-      if(Nstp >= Nfsteps) EXIT
-   else
-     cell_done(1:VL) = ( .NOT. (T(1:VL)-Tend)+Roundoff <= ZERO  )  .OR. &
-          (IERRV(1:VL) < 0) ! mz_pj_20070516
-     call kco_compress (VL, T, H, Hnew, IERRV, y, RCONST, FIX_lo,         &
-                                     RejectLastH, RejectMoreH, Kacc, Krej)
-     if(VL == 0)   EXIT
-   end if
-
-!kk   write(0,*) '  aaa ',icount,Nstp,count(cell_done),count(Accept_step),VL,minval(T)
-   END DO TimeLoop
-
-!~~~> Succesful exit
-   IERR = 1  !~~~> The integration was successful
-
-   IF (.not. l_fixed_step) then
-     call kco_finalize (y, IERRV, Kacc, Krej)
-   end if
-
-   VL = VL_save
-
-!kk   write(0,*) 'bbb ',icount,Nstp,maxval(Kacc),maxval(Krej)
-!kk   if(icount >= 10)  call abort()
-
-  END SUBROUTINE ros_Integrator
-
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  FUNCTION ros_ErrorNorm ( Y, Ynew, Yerr, &
-               AbsTol, RelTol, VectorTol )
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!~~~> Computes the "scaled norm" of the error vector Yerr
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-   IMPLICIT NONE
-
-! Input arguments
-   REAL(kind=dp), INTENT(IN) :: Y(:,:), Ynew(:,:), &
-          Yerr(:,:), AbsTol(NVAR), RelTol(NVAR)
-   LOGICAL, INTENT(IN) ::  VectorTol
-! Local variables
-   REAL(kind=dp), dimension(VL)       :: Err, Scale, Ymax
-   INTEGER  :: i
-   REAL(kind=dp), PARAMETER           :: ZERO = 0.0_dp
-   REAL(kind=dp), dimension(VL)       :: ros_ErrorNorm
-
-   Err = ZERO
-   DO i=1,NVAR
-     Ymax = MAX( ABS(Y(1:VL,i)),ABS(Ynew(1:VL,i)))
-     IF (VectorTol) THEN
-       Scale = AbsTol(i)+ RelTol(i)*Ymax
-     ELSE
-       Scale = AbsTol(1)+ RelTol(1)*Ymax
-     END IF
-     Err = Err+ (Yerr(1:VL,i)/Scale)**2
-   END DO
-   Err  = SQRT(Err/NVAR)
-
-   ros_ErrorNorm = Err
-
-  END FUNCTION ros_ErrorNorm
-
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-  SUBROUTINE ros_PrepareMatrix ( H, gam, Jac0, Ghimj )
-
-! --- --- --- --- --- --- --- --- --- --- --- --- ---
-!  Prepares the LHS matrix for stage calculations
-!  1.  Construct Ghimj = 1/(H*ham) - Jac0
-!      "(Gamma H) Inverse Minus Jacobian"
-!  2.  Repeat LU decomposition of Ghimj until successful.
-!       -half the step size if LU decomposition fails and retry
-!       -exit after 5 consecutive fails
-! --- --- --- --- --- --- --- --- --- --- --- --- ---
-   IMPLICIT NONE
-
-!~~~> Input arguments
-   REAL(kind=dp), INTENT(IN) ::  Jac0(:,:)
-   REAL(kind=dp), INTENT(IN) ::  gam
-!~~~> Output arguments
-   REAL(kind=dp), INTENT(OUT) :: Ghimj(:,:)
-!~~~> Inout arguments
-   REAL(kind=dp), INTENT(INOUT) :: H(:)   ! step size is decreased when LU fails
-!~~~> Local variables
-   INTEGER  :: i, ising, Nconsecutive
-   REAL(kind=dp), dimension(size(H)) :: ghinv
-   REAL(kind=dp), PARAMETER :: ONE  = 1.0_dp, HALF = 0.5_dp
-
-   Nconsecutive = 0
-
-
-!~~~>    Construct Ghimj = 1/(H*gam) - Jac0
-   Ghimj(1:VL,1:LU_NONZERO) = -ONE * JAC0(1:VL,1:LU_NONZERO)
-   ghinv(1:VL) = ONE/(H(1:VL)*gam)
-   DO i=1,NVAR
-     Ghimj(1:VL,LU_DIAG(i)) = Ghimj(1:VL,LU_DIAG(i))+ghinv(1:VL)
-   END DO
-
-!~~~>    Compute LU decomposition
-!CDIR noiexpand
-   CALL KppDecomp( Ghimj, ising )
-
-   Ndec = Ndec + VL
-
-  END SUBROUTINE ros_PrepareMatrix
-
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  SUBROUTINE ros_Solve( A, b )
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!  Template for the forward/backward substitution (using pre-computed LU decomposition)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-   IMPLICIT NONE
-!~~~> Input variables
-   REAL(kind=dp), INTENT(IN)         :: A(:,:)
-!~~~> InOut variables
-   REAL(kind=dp), INTENT(INOUT)      :: b(:,:)
-
-   CALL KppSolve( A, b )
-
-   Nsol = Nsol+VL
-
-  END SUBROUTINE ros_Solve
-
-
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  SUBROUTINE Ros2 (ros_S,ros_A,ros_C,ros_M,ros_E,ros_Alpha,&
-            ros_Gamma,ros_NewF,ros_ELO,ros_Name)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-! --- AN L-STABLE METHOD, 2 stages, order 2
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-  IMPLICIT NONE
-
-   INTEGER, PARAMETER :: S=2
-   INTEGER, INTENT(OUT) ::  ros_S
-   REAL(kind=dp), DIMENSION(S), INTENT(OUT) :: ros_M,ros_E,ros_Alpha,ros_Gamma
-   REAL(kind=dp), DIMENSION(S*(S-1)/2), INTENT(OUT) :: ros_A, ros_C
-   REAL(kind=dp), INTENT(OUT) :: ros_ELO
-   LOGICAL, DIMENSION(S), INTENT(OUT) :: ros_NewF
-   CHARACTER(LEN=12), INTENT(OUT) :: ros_Name
-   DOUBLE PRECISION g
-
-    g = 1.0_dp + 1.0_dp/SQRT(2.0_dp)
-
-!~~~> Name of the method
-    ros_Name = 'ROS-2'
-!~~~> Number of stages
-    ros_S = S
-
-!~~~> The coefficient matrices A and C are strictly lower triangular.
-!   The lower triangular (subdiagonal) elements are stored in row-wise order:
-!   A(2,1) = ros_A(1), A(3,1)=ros_A(2), A(3,2)=ros_A(3), etc.
-!   The general mapping formula is:
-!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j )
-!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j )
-
-    ros_A(1) = (1.0_dp)/g
-    ros_C(1) = (-2.0_dp)/g
-!~~~> Does the stage i require a new function evaluation (ros_NewF(i)=TRUE)
-!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i)=FALSE)
-    ros_NewF(1) = .TRUE.
-    ros_NewF(2) = .TRUE.
-!~~~> M_i = Coefficients for new step solution
-    ros_M(1)= (3.0_dp)/(2.0_dp*g)
-    ros_M(2)= (1.0_dp)/(2.0_dp*g)
-! E_i = Coefficients for error estimator
-    ros_E(1) = 1.0_dp/(2.0_dp*g)
-    ros_E(2) = 1.0_dp/(2.0_dp*g)
-!~~~> ros_ELO = estimator of local order - the minimum between the
-!    main and the embedded scheme orders plus one
-    ros_ELO = 2.0_dp
-!~~~> Y_stage_i ~ Y( T + H*Alpha_i )
-    ros_Alpha(1) = 0.0_dp
-    ros_Alpha(2) = 1.0_dp
-!~~~> Gamma_i = \sum_j  gamma_{i,j}
-    ros_Gamma(1) = g
-    ros_Gamma(2) =-g
-
- END SUBROUTINE Ros2
-
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  SUBROUTINE Ros3 (ros_S,ros_A,ros_C,ros_M,ros_E,ros_Alpha,&
-           ros_Gamma,ros_NewF,ros_ELO,ros_Name)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-! --- AN L-STABLE METHOD, 3 stages, order 3, 2 function evaluations
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-  IMPLICIT NONE
-
-   INTEGER, PARAMETER :: S=3
-   INTEGER, INTENT(OUT) ::  ros_S
-   REAL(kind=dp), DIMENSION(S), INTENT(OUT) :: ros_M,ros_E,ros_Alpha,ros_Gamma
-   REAL(kind=dp), DIMENSION(S*(S-1)/2), INTENT(OUT) :: ros_A, ros_C
-   REAL(kind=dp), INTENT(OUT) :: ros_ELO
-   LOGICAL, DIMENSION(S), INTENT(OUT) :: ros_NewF
-   CHARACTER(LEN=12), INTENT(OUT) :: ros_Name
-
-!~~~> Name of the method
-   ros_Name = 'ROS-3'
-!~~~> Number of stages
-   ros_S = S
-
-!~~~> The coefficient matrices A and C are strictly lower triangular.
-!   The lower triangular (subdiagonal) elements are stored in row-wise order:
-!   A(2,1) = ros_A(1), A(3,1)=ros_A(2), A(3,2)=ros_A(3), etc.
-!   The general mapping formula is:
-!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j )
-!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j )
-
-   ros_A(1)= 1.0_dp
-   ros_A(2)= 1.0_dp
-   ros_A(3)= 0.0_dp
-
-   ros_C(1) = -0.10156171083877702091975600115545E+01_dp
-   ros_C(2) =  0.40759956452537699824805835358067E+01_dp
-   ros_C(3) =  0.92076794298330791242156818474003E+01_dp
-!~~~> Does the stage i require a new function evaluation (ros_NewF(i)=TRUE)
-!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i)=FALSE)
-   ros_NewF(1) = .TRUE.
-   ros_NewF(2) = .TRUE.
-   ros_NewF(3) = .FALSE.
-!~~~> M_i = Coefficients for new step solution
-   ros_M(1) =  0.1E+01_dp
-   ros_M(2) =  0.61697947043828245592553615689730E+01_dp
-   ros_M(3) = -0.42772256543218573326238373806514E+00_dp
-! E_i = Coefficients for error estimator
-   ros_E(1) =  0.5E+00_dp
-   ros_E(2) = -0.29079558716805469821718236208017E+01_dp
-   ros_E(3) =  0.22354069897811569627360909276199E+00_dp
-!~~~> ros_ELO = estimator of local order - the minimum between the
-!    main and the embedded scheme orders plus 1
-   ros_ELO = 3.0_dp
-!~~~> Y_stage_i ~ Y( T + H*Alpha_i )
-   ros_Alpha(1)= 0.0E+00_dp
-   ros_Alpha(2)= 0.43586652150845899941601945119356E+00_dp
-   ros_Alpha(3)= 0.43586652150845899941601945119356E+00_dp
-!~~~> Gamma_i = \sum_j  gamma_{i,j}
-   ros_Gamma(1)= 0.43586652150845899941601945119356E+00_dp
-   ros_Gamma(2)= 0.24291996454816804366592249683314E+00_dp
-   ros_Gamma(3)= 0.21851380027664058511513169485832E+01_dp
-
-  END SUBROUTINE Ros3
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  SUBROUTINE Ros4 (ros_S,ros_A,ros_C,ros_M,ros_E,ros_Alpha,&
-           ros_Gamma,ros_NewF,ros_ELO,ros_Name)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!     L-STABLE ROSENBROCK METHOD OF ORDER 4, WITH 4 STAGES
-!     L-STABLE EMBEDDED ROSENBROCK METHOD OF ORDER 3
-!
-!      E. HAIRER AND G. WANNER, SOLVING ORDINARY DIFFERENTIAL
-!      EQUATIONS II. STIFF AND DIFFERENTIAL-ALGEBRAIC PROBLEMS.
-!      SPRINGER SERIES IN COMPUTATIONAL MATHEMATICS,
-!      SPRINGER-VERLAG (1990)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-  IMPLICIT NONE
-
-   INTEGER, PARAMETER :: S=4
-   INTEGER, INTENT(OUT) ::  ros_S
-   REAL(kind=dp), DIMENSION(4), INTENT(OUT) :: ros_M,ros_E,ros_Alpha,ros_Gamma
-   REAL(kind=dp), DIMENSION(6), INTENT(OUT) :: ros_A, ros_C
-   REAL(kind=dp), INTENT(OUT) :: ros_ELO
-   LOGICAL, DIMENSION(4), INTENT(OUT) :: ros_NewF
-   CHARACTER(LEN=12), INTENT(OUT) :: ros_Name
-   DOUBLE PRECISION g
-
-!~~~> Name of the method
-   ros_Name = 'ROS-4'
-!~~~> Number of stages
-   ros_S = S
-
-!~~~> The coefficient matrices A and C are strictly lower triangular.
-!   The lower triangular (subdiagonal) elements are stored in row-wise order:
-!   A(2,1) = ros_A(1), A(3,1)=ros_A(2), A(3,2)=ros_A(3), etc.
-!   The general mapping formula is:
-!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j )
-!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j )
-
-   ros_A(1) = 0.2000000000000000E+01_dp
-   ros_A(2) = 0.1867943637803922E+01_dp
-   ros_A(3) = 0.2344449711399156E+00_dp
-   ros_A(4) = ros_A(2)
-   ros_A(5) = ros_A(3)
-   ros_A(6) = 0.0_dp
-
-   ros_C(1) =-0.7137615036412310E+01_dp
-   ros_C(2) = 0.2580708087951457E+01_dp
-   ros_C(3) = 0.6515950076447975E+00_dp
-   ros_C(4) =-0.2137148994382534E+01_dp
-   ros_C(5) =-0.3214669691237626E+00_dp
-   ros_C(6) =-0.6949742501781779E+00_dp
-!~~~> Does the stage i require a new function evaluation (ros_NewF(i)=TRUE)
-!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i)=FALSE)
-   ros_NewF(1)  = .TRUE.
-   ros_NewF(2)  = .TRUE.
-   ros_NewF(3)  = .TRUE.
-   ros_NewF(4)  = .FALSE.
-!~~~> M_i = Coefficients for new step solution
-   ros_M(1) = 0.2255570073418735E+01_dp
-   ros_M(2) = 0.2870493262186792E+00_dp
-   ros_M(3) = 0.4353179431840180E+00_dp
-   ros_M(4) = 0.1093502252409163E+01_dp
-!~~~> E_i  = Coefficients for error estimator
-   ros_E(1) =-0.2815431932141155E+00_dp
-   ros_E(2) =-0.7276199124938920E-01_dp
-   ros_E(3) =-0.1082196201495311E+00_dp
-   ros_E(4) =-0.1093502252409163E+01_dp
-!~~~> ros_ELO  = estimator of local order - the minimum between the
-!    main and the embedded scheme orders plus 1
-   ros_ELO  = 4.0_dp
-!~~~> Y_stage_i ~ Y( T + H*Alpha_i )
-   ros_Alpha(1) = 0.0_dp
-   ros_Alpha(2) = 0.1145640000000000E+01_dp
-   ros_Alpha(3) = 0.6552168638155900E+00_dp
-   ros_Alpha(4) = ros_Alpha(3)
-!~~~> Gamma_i = \sum_j  gamma_{i,j}
-   ros_Gamma(1) = 0.5728200000000000E+00_dp
-   ros_Gamma(2) =-0.1769193891319233E+01_dp
-   ros_Gamma(3) = 0.7592633437920482E+00_dp
-   ros_Gamma(4) =-0.1049021087100450E+00_dp
-
-  END SUBROUTINE Ros4
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  SUBROUTINE Rodas3 (ros_S,ros_A,ros_C,ros_M,ros_E,ros_Alpha,&
-            ros_Gamma,ros_NewF,ros_ELO,ros_Name)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-! --- A STIFFLY-STABLE METHOD, 4 stages, order 3
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-  IMPLICIT NONE
-
-   INTEGER, PARAMETER :: S=4
-   INTEGER, INTENT(OUT) ::  ros_S
-   REAL(kind=dp), DIMENSION(S), INTENT(OUT) :: ros_M,ros_E,ros_Alpha,ros_Gamma
-   REAL(kind=dp), DIMENSION(S*(S-1)/2), INTENT(OUT) :: ros_A, ros_C
-   REAL(kind=dp), INTENT(OUT) :: ros_ELO
-   LOGICAL, DIMENSION(S), INTENT(OUT) :: ros_NewF
-   CHARACTER(LEN=12), INTENT(OUT) :: ros_Name
-   DOUBLE PRECISION g
-
-!~~~> Name of the method
-   ros_Name = 'RODAS-3'
-!~~~> Number of stages
-   ros_S = S
-
-!~~~> The coefficient matrices A and C are strictly lower triangular.
-!   The lower triangular (subdiagonal) elements are stored in row-wise order:
-!   A(2,1) = ros_A(1), A(3,1)=ros_A(2), A(3,2)=ros_A(3), etc.
-!   The general mapping formula is:
-!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j )
-!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j )
-
-   ros_A(1) = 0.0E+00_dp
-   ros_A(2) = 2.0E+00_dp
-   ros_A(3) = 0.0E+00_dp
-   ros_A(4) = 2.0E+00_dp
-   ros_A(5) = 0.0E+00_dp
-   ros_A(6) = 1.0E+00_dp
-
-   ros_C(1) = 4.0E+00_dp
-   ros_C(2) = 1.0E+00_dp
-   ros_C(3) =-1.0E+00_dp
-   ros_C(4) = 1.0E+00_dp
-   ros_C(5) =-1.0E+00_dp
-   ros_C(6) =-(8.0E+00_dp/3.0E+00_dp)
-
-!~~~> Does the stage i require a new function evaluation (ros_NewF(i)=TRUE)
-!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i)=FALSE)
-   ros_NewF(1)  = .TRUE.
-   ros_NewF(2)  = .FALSE.
-   ros_NewF(3)  = .TRUE.
-   ros_NewF(4)  = .TRUE.
-!~~~> M_i = Coefficients for new step solution
-   ros_M(1) = 2.0E+00_dp
-   ros_M(2) = 0.0E+00_dp
-   ros_M(3) = 1.0E+00_dp
-   ros_M(4) = 1.0E+00_dp
-!~~~> E_i  = Coefficients for error estimator
-   ros_E(1) = 0.0E+00_dp
-   ros_E(2) = 0.0E+00_dp
-   ros_E(3) = 0.0E+00_dp
-   ros_E(4) = 1.0E+00_dp
-!~~~> ros_ELO  = estimator of local order - the minimum between the
-!    main and the embedded scheme orders plus 1
-   ros_ELO  = 3.0E+00_dp
-!~~~> Y_stage_i ~ Y( T + H*Alpha_i )
-   ros_Alpha(1) = 0.0E+00_dp
-   ros_Alpha(2) = 0.0E+00_dp
-   ros_Alpha(3) = 1.0E+00_dp
-   ros_Alpha(4) = 1.0E+00_dp
-!~~~> Gamma_i = \sum_j  gamma_{i,j}
-   ros_Gamma(1) = 0.5E+00_dp
-   ros_Gamma(2) = 1.5E+00_dp
-   ros_Gamma(3) = 0.0E+00_dp
-   ros_Gamma(4) = 0.0E+00_dp
-
-  END SUBROUTINE Rodas3
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  SUBROUTINE Rodas4 (ros_S,ros_A,ros_C,ros_M,ros_E,ros_Alpha,&
-             ros_Gamma,ros_NewF,ros_ELO,ros_Name)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!     STIFFLY-STABLE ROSENBROCK METHOD OF ORDER 4, WITH 6 STAGES
-!
-!      E. HAIRER AND G. WANNER, SOLVING ORDINARY DIFFERENTIAL
-!      EQUATIONS II. STIFF AND DIFFERENTIAL-ALGEBRAIC PROBLEMS.
-!      SPRINGER SERIES IN COMPUTATIONAL MATHEMATICS,
-!      SPRINGER-VERLAG (1996)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-  IMPLICIT NONE
-
-   INTEGER, PARAMETER :: S=6
-   INTEGER, INTENT(OUT) ::  ros_S
-   REAL(kind=dp), DIMENSION(S), INTENT(OUT) :: ros_M,ros_E,ros_Alpha,ros_Gamma
-   REAL(kind=dp), DIMENSION(S*(S-1)/2), INTENT(OUT) :: ros_A, ros_C
-   REAL(kind=dp), INTENT(OUT) :: ros_ELO
-   LOGICAL, DIMENSION(S), INTENT(OUT) :: ros_NewF
-   CHARACTER(LEN=12), INTENT(OUT) :: ros_Name
-   DOUBLE PRECISION g
-
-!~~~> Name of the method
-    ros_Name = 'RODAS-4'
-!~~~> Number of stages
-    ros_S = 6
-
-!~~~> Y_stage_i ~ Y( T + H*Alpha_i )
-    ros_Alpha(1) = 0.000_dp
-    ros_Alpha(2) = 0.386_dp
-    ros_Alpha(3) = 0.210_dp
-    ros_Alpha(4) = 0.630_dp
-    ros_Alpha(5) = 1.000_dp
-    ros_Alpha(6) = 1.000_dp
-
-!~~~> Gamma_i = \sum_j  gamma_{i,j}
-    ros_Gamma(1) = 0.2500000000000000E+00_dp
-    ros_Gamma(2) =-0.1043000000000000E+00_dp
-    ros_Gamma(3) = 0.1035000000000000E+00_dp
-    ros_Gamma(4) =-0.3620000000000023E-01_dp
-    ros_Gamma(5) = 0.0_dp
-    ros_Gamma(6) = 0.0_dp
-
-!~~~> The coefficient matrices A and C are strictly lower triangular.
-!   The lower triangular (subdiagonal) elements are stored in row-wise order:
-!   A(2,1) = ros_A(1), A(3,1)=ros_A(2), A(3,2)=ros_A(3), etc.
-!   The general mapping formula is:  A(i,j) = ros_A( (i-1)*(i-2)/2 + j )
-!                  C(i,j) = ros_C( (i-1)*(i-2)/2 + j )
-
-    ros_A(1) = 0.1544000000000000E+01_dp
-    ros_A(2) = 0.9466785280815826E+00_dp
-    ros_A(3) = 0.2557011698983284E+00_dp
-    ros_A(4) = 0.3314825187068521E+01_dp
-    ros_A(5) = 0.2896124015972201E+01_dp
-    ros_A(6) = 0.9986419139977817E+00_dp
-    ros_A(7) = 0.1221224509226641E+01_dp
-    ros_A(8) = 0.6019134481288629E+01_dp
-    ros_A(9) = 0.1253708332932087E+02_dp
-    ros_A(10) =-0.6878860361058950E+00_dp
-    ros_A(11) = ros_A(7)
-    ros_A(12) = ros_A(8)
-    ros_A(13) = ros_A(9)
-    ros_A(14) = ros_A(10)
-    ros_A(15) = 1.0E+00_dp
-
-    ros_C(1) =-0.5668800000000000E+01_dp
-    ros_C(2) =-0.2430093356833875E+01_dp
-    ros_C(3) =-0.2063599157091915E+00_dp
-    ros_C(4) =-0.1073529058151375E+00_dp
-    ros_C(5) =-0.9594562251023355E+01_dp
-    ros_C(6) =-0.2047028614809616E+02_dp
-    ros_C(7) = 0.7496443313967647E+01_dp
-    ros_C(8) =-0.1024680431464352E+02_dp
-    ros_C(9) =-0.3399990352819905E+02_dp
-    ros_C(10) = 0.1170890893206160E+02_dp
-    ros_C(11) = 0.8083246795921522E+01_dp
-    ros_C(12) =-0.7981132988064893E+01_dp
-    ros_C(13) =-0.3152159432874371E+02_dp
-    ros_C(14) = 0.1631930543123136E+02_dp
-    ros_C(15) =-0.6058818238834054E+01_dp
-
-!~~~> M_i = Coefficients for new step solution
-    ros_M(1) = ros_A(7)
-    ros_M(2) = ros_A(8)
-    ros_M(3) = ros_A(9)
-    ros_M(4) = ros_A(10)
-    ros_M(5) = 1.0E+00_dp
-    ros_M(6) = 1.0E+00_dp
-
-!~~~> E_i  = Coefficients for error estimator
-    ros_E(1) = 0.0E+00_dp
-    ros_E(2) = 0.0E+00_dp
-    ros_E(3) = 0.0E+00_dp
-    ros_E(4) = 0.0E+00_dp
-    ros_E(5) = 0.0E+00_dp
-    ros_E(6) = 1.0E+00_dp
-
-!~~~> Does the stage i require a new function evaluation (ros_NewF(i)=TRUE)
-!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i)=FALSE)
-    ros_NewF(1) = .TRUE.
-    ros_NewF(2) = .TRUE.
-    ros_NewF(3) = .TRUE.
-    ros_NewF(4) = .TRUE.
-    ros_NewF(5) = .TRUE.
-    ros_NewF(6) = .TRUE.
-
-!~~~> ros_ELO  = estimator of local order - the minimum between the
-!        main and the embedded scheme orders plus 1
-    ros_ELO = 4.0_dp
-
-  END SUBROUTINE Rodas4
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!   End of the set of internal Rosenbrock subroutines
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-END SUBROUTINE Rosenbrock
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/templates/rosenbrock_vec.f90.save
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/templates/rosenbrock_vec.f90.save	(revision 3297)
+++ 	(revision )
@@ -1,1152 +1,0 @@
-SUBROUTINE Rosenbrock(Y,Tstart,Tend, &
-           AbsTol,RelTol,            &
-           RCNTRL,ICNTRL,RSTATUS,ISTATUS,IERR)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!
-!    Solves the system y'=F(t,y) using a Rosenbrock method defined by:
-!
-!     G = 1/(H*gamma(1)) - Jac(t0,Y0)
-!     T_i = t0 + Alpha(i)*H
-!     Y_i = Y0 + \sum_{j=1}^{i-1} A(i,j)*K_j
-!     G * K_i = Fun( T_i, Y_i ) + \sum_{j=1}^S C(i,j)/H * K_j +
-!         gamma(i)*dF/dT(t0, Y0)
-!     Y1 = Y0 + \sum_{j=1}^S M(j)*K_j
-!
-!    For details on Rosenbrock methods and their implementation consult:
-!      E. Hairer and G. Wanner
-!      "Solving ODEs II. Stiff and differential-algebraic problems".
-!      Springer series in computational mathematics, Springer-Verlag, 1996.
-!    The codes contained in the book inspired this implementation.
-!
-!    (C)  Adrian Sandu, August 2004
-!    Virginia Polytechnic Institute and State University
-!    Contact: sandu@cs.vt.edu
-!    This implementation is part of KPP - the Kinetic PreProcessor
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!
-!~~~>   INPUT ARGUMENTS:
-!
-!-     Y(NVAR)    = vector of initial conditions (at T=Tstart)
-!-    [Tstart,Tend]  = time range of integration
-!     (if Tstart>Tend the integration is performed backwards in time)
-!-    RelTol, AbsTol = user precribed accuracy
-!- SUBROUTINE  Fun( T, Y, Ydot ) = ODE function,
-!                       returns Ydot = Y' = F(T,Y)
-!- SUBROUTINE  Jac( T, Y, Jcb ) = Jacobian of the ODE function,
-!                       returns Jcb = dFun/dY
-!-    ICNTRL(1:20)    = integer inputs parameters
-!-    RCNTRL(1:20)    = real inputs parameters
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!
-!~~~>     OUTPUT ARGUMENTS:
-!
-!-    Y(NVAR)    -> vector of final states (at T->Tend)
-!-    ISTATUS(1:20)   -> integer output parameters
-!-    RSTATUS(1:20)   -> real output parameters
-!-    IERR            -> job status upon return
-!                        success (positive value) or
-!                        failure (negative value)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!
-!~~~>     INPUT PARAMETERS:
-!
-!    Note: For input parameters equal to zero the default values of the
-!       corresponding variables are used.
-!
-!    ICNTRL(1) = 1: F = F(y)   Independent of T (AUTONOMOUS)
-!              = 0: F = F(t,y) Depends on T (NON-AUTONOMOUS)
-!
-!    ICNTRL(2) = 0: AbsTol, RelTol are NVAR-dimensional vectors
-!              = 1: AbsTol, RelTol are scalars
-!
-!    ICNTRL(3)  -> selection of a particular Rosenbrock method
-!        = 0 :  default method is Rodas3
-!        = 1 :  method is  Ros2
-!        = 2 :  method is  Ros3
-!        = 3 :  method is  Ros4
-!        = 4 :  method is  Rodas3
-!        = 5:   method is  Rodas4
-!
-!    ICNTRL(4)  -> maximum number of integration steps
-!        For ICNTRL(4)=0) the default value of 100000 is used
-!
-!    RCNTRL(1)  -> Hmin, lower bound for the integration step size
-!          It is strongly recommended to keep Hmin = ZERO
-!    RCNTRL(2)  -> Hmax, upper bound for the integration step size
-!    RCNTRL(3)  -> Hstart, starting value for the integration step size
-!
-!    RCNTRL(4)  -> FacMin, lower bound on step decrease factor (default=0.2)
-!    RCNTRL(5)  -> FacMax, upper bound on step increase factor (default=6)
-!    RCNTRL(6)  -> FacRej, step decrease factor after multiple rejections
-!            (default=0.1)
-!    RCNTRL(7)  -> FacSafe, by which the new step is slightly smaller
-!         than the predicted value  (default=0.9)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!
-!~~~>     OUTPUT PARAMETERS:
-!
-!    Note: each call to Rosenbrock adds the current no. of fcn calls
-!      to previous value of ISTATUS(1), and similar for the other params.
-!      Set ISTATUS(1:20) = 0 before call to avoid this accumulation.
-!
-!    ISTATUS(1) = No. of function calls
-!    ISTATUS(2) = No. of jacobian calls
-!    ISTATUS(3) = No. of steps
-!    ISTATUS(4) = No. of accepted steps
-!    ISTATUS(5) = No. of rejected steps (except at the beginning)
-!    ISTATUS(6) = No. of LU decompositions
-!    ISTATUS(7) = No. of forward/backward substitutions
-!    ISTATUS(8) = No. of singular matrix decompositions
-!
-!    RSTATUS(1)  -> Texit, the time corresponding to the
-!                   computed Y upon return
-!    RSTATUS(2)  -> Hexit, last accepted step before exit
-!    For multiple restarts, use Hexit as Hstart in the following run
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-  IMPLICIT NONE
-
-!~~~>  Arguments
-   REAL(kind=dp), INTENT(INOUT) :: Y(:,:)
-   REAL(kind=dp), INTENT(IN)   :: Tstart,Tend
-   REAL(kind=dp), INTENT(IN)   :: AbsTol(NVAR),RelTol(NVAR)
-   INTEGER, INTENT(IN)    :: ICNTRL(20)
-   REAL(kind=dp), INTENT(IN)   :: RCNTRL(20)
-   INTEGER, INTENT(INOUT) :: ISTATUS(20)
-   REAL(kind=dp), INTENT(INOUT) :: RSTATUS(20)
-   INTEGER, INTENT(OUT)   :: IERR
-!~~~>  The method parameters
-   INTEGER, PARAMETER :: Smax = 6
-   INTEGER  :: Method, ros_S
-   REAL(kind=dp), DIMENSION(Smax) :: ros_M, ros_E, ros_Alpha, ros_Gamma
-   REAL(kind=dp), DIMENSION(Smax*(Smax-1)/2) :: ros_A, ros_C
-   REAL(kind=dp) :: ros_ELO
-   LOGICAL, DIMENSION(Smax) :: ros_NewF
-   CHARACTER(LEN=12) :: ros_Name
-!~~~>  Local variables
-   REAL(kind=dp) :: Roundoff, FacMin, FacMax, FacRej, FacSafe
-   REAL(kind=dp) :: Hmin, Hmax, Hstart, Hexit
-   REAL(kind=dp) :: Texit
-   INTEGER :: i, UplimTol, Max_no_steps
-   LOGICAL :: Autonomous, VectorTol
-!~~~>   Parameters
-   REAL(kind=dp), PARAMETER :: ZERO = 0.0_dp, ONE  = 1.0_dp
-   REAL(kind=dp), PARAMETER :: DeltaMin = 1.0E-5_dp
-
-!~~~>  Initialize statistics
-   Nfun = ISTATUS(ifun)
-   Njac = ISTATUS(ijac)
-   Nstp = ISTATUS(istp)
-   Nacc = ISTATUS(iacc)
-   Nrej = ISTATUS(irej)
-   Ndec = ISTATUS(idec)
-   Nsol = ISTATUS(isol)
-   Nsng = ISTATUS(isng)
-
-!~~~>  Autonomous or time dependent ODE. Default is time dependent.
-   Autonomous = .NOT.(ICNTRL(1) == 0)
-
-!~~~>  For Scalar tolerances (ICNTRL(2).NE.0)  the code uses AbsTol(1) and RelTol(1)
-!   For Vector tolerances (ICNTRL(2) == 0) the code uses AbsTol(1:NVAR) and RelTol(1:NVAR)
-   IF (ICNTRL(2) == 0) THEN
-      VectorTol = .TRUE.
-         UplimTol  = NVAR
-   ELSE
-      VectorTol = .FALSE.
-         UplimTol  = 1
-   END IF
-
-!~~~>  The particular Rosenbrock method chosen
-   IF (ICNTRL(3) == 0) THEN
-      Method = 4
-   ELSEIF ( (ICNTRL(3) >= 1).AND.(ICNTRL(3) <= 5) ) THEN
-      Method = ICNTRL(3)
-   ELSE
-      PRINT * , 'User-selected Rosenbrock method: ICNTRL(3)=', Method
-      CALL ros_ErrorMsg(-2,Tstart,ZERO,IERR)
-      RETURN
-   END IF
-
-!~~~>   The maximum number of steps admitted
-   IF (ICNTRL(4) == 0) THEN
-      Max_no_steps = 100000 ! 200
-   ELSEIF (ICNTRL(4) > 0) THEN
-      Max_no_steps=ICNTRL(4)
-   ELSE
-      PRINT * ,'User-selected max no. of steps: ICNTRL(4)=',ICNTRL(4)
-      CALL ros_ErrorMsg(-1,Tstart,ZERO,IERR)
-      RETURN
-   END IF
-
-!~~~>  Unit roundoff (1+Roundoff>1)
-   Roundoff = WLAMCH('E')
-
-!~~~>  Lower bound on the step size: (positive value)
-   IF (RCNTRL(1) == ZERO) THEN
-      Hmin = ZERO
-   ELSEIF (RCNTRL(1) > ZERO) THEN
-      Hmin = RCNTRL(1)
-   ELSE
-      PRINT * , 'User-selected Hmin: RCNTRL(1)=', RCNTRL(1)
-      CALL ros_ErrorMsg(-3,Tstart,ZERO,IERR)
-      RETURN
-   END IF
-!~~~>  Upper bound on the step size: (positive value)
-   IF (RCNTRL(2) == ZERO) THEN
-      Hmax = ABS(Tend-Tstart)
-   ELSEIF (RCNTRL(2) > ZERO) THEN
-      Hmax = MIN(ABS(RCNTRL(2)),ABS(Tend-Tstart))
-   ELSE
-      PRINT * , 'User-selected Hmax: RCNTRL(2)=', RCNTRL(2)
-      CALL ros_ErrorMsg(-3,Tstart,ZERO,IERR)
-      RETURN
-   END IF
-!~~~>  Starting step size: (positive value)
-   IF (RCNTRL(3) == ZERO) THEN
-      Hstart = MAX(Hmin,DeltaMin)
-   ELSEIF (RCNTRL(3) > ZERO) THEN
-      Hstart = MIN(ABS(RCNTRL(3)),ABS(Tend-Tstart))
-   ELSE
-      PRINT * , 'User-selected Hstart: RCNTRL(3)=', RCNTRL(3)
-      CALL ros_ErrorMsg(-3,Tstart,ZERO,IERR)
-      RETURN
-   END IF
-!~~~>  Step size can be changed s.t.  FacMin < Hnew/Hexit < FacMax
-   IF (RCNTRL(4) == ZERO) THEN
-      FacMin = 0.2_dp
-   ELSEIF (RCNTRL(4) > ZERO) THEN
-      FacMin = RCNTRL(4)
-   ELSE
-      PRINT * , 'User-selected FacMin: RCNTRL(4)=', RCNTRL(4)
-      CALL ros_ErrorMsg(-4,Tstart,ZERO,IERR)
-      RETURN
-   END IF
-   IF (RCNTRL(5) == ZERO) THEN
-      FacMax = 6.0_dp
-   ELSEIF (RCNTRL(5) > ZERO) THEN
-      FacMax = RCNTRL(5)
-   ELSE
-      PRINT * , 'User-selected FacMax: RCNTRL(5)=', RCNTRL(5)
-      CALL ros_ErrorMsg(-4,Tstart,ZERO,IERR)
-      RETURN
-   END IF
-!~~~>   FacRej: Factor to decrease step after 2 succesive rejections
-   IF (RCNTRL(6) == ZERO) THEN
-      FacRej = 0.1_dp
-   ELSEIF (RCNTRL(6) > ZERO) THEN
-      FacRej = RCNTRL(6)
-   ELSE
-      PRINT * , 'User-selected FacRej: RCNTRL(6)=', RCNTRL(6)
-      CALL ros_ErrorMsg(-4,Tstart,ZERO,IERR)
-      RETURN
-   END IF
-!~~~>   FacSafe: Safety Factor in the computation of new step size
-   IF (RCNTRL(7) == ZERO) THEN
-      FacSafe = 0.9_dp
-   ELSEIF (RCNTRL(7) > ZERO) THEN
-      FacSafe = RCNTRL(7)
-   ELSE
-      PRINT * , 'User-selected FacSafe: RCNTRL(7)=', RCNTRL(7)
-      CALL ros_ErrorMsg(-4,Tstart,ZERO,IERR)
-      RETURN
-   END IF
-!~~~>  Check if tolerances are reasonable
-    DO i=1,UplimTol
-      IF ( (AbsTol(i) <= ZERO) .OR. (RelTol(i) <= 10.0_dp*Roundoff) &
-         .OR. (RelTol(i) >= 1.0_dp) ) THEN
-        PRINT * , ' AbsTol(',i,') = ',AbsTol(i)
-        PRINT * , ' RelTol(',i,') = ',RelTol(i)
-        CALL ros_ErrorMsg(-5,Tstart,ZERO,IERR)
-        RETURN
-      END IF
-    END DO
-
-
-!~~~>   Initialize the particular Rosenbrock method
-   SELECT CASE (Method)
-     CASE (1)
-       CALL Ros2(ros_S, ros_A, ros_C, ros_M, ros_E,   &
-          ros_Alpha, ros_Gamma, ros_NewF, ros_ELO, ros_Name)
-     CASE (2)
-       CALL Ros3(ros_S, ros_A, ros_C, ros_M, ros_E,   &
-          ros_Alpha, ros_Gamma, ros_NewF, ros_ELO, ros_Name)
-     CASE (3)
-       CALL Ros4(ros_S, ros_A, ros_C, ros_M, ros_E,   &
-          ros_Alpha, ros_Gamma, ros_NewF, ros_ELO, ros_Name)
-     CASE (4)
-       CALL Rodas3(ros_S, ros_A, ros_C, ros_M, ros_E, &
-          ros_Alpha, ros_Gamma, ros_NewF, ros_ELO, ros_Name)
-     CASE (5)
-       CALL Rodas4(ros_S, ros_A, ros_C, ros_M, ros_E, &
-          ros_Alpha, ros_Gamma, ros_NewF, ros_ELO, ros_Name)
-     CASE DEFAULT
-       PRINT * , 'Unknown Rosenbrock method: ICNTRL(3)=', Method
-       CALL ros_ErrorMsg(-2,Tstart,ZERO,IERR)
-       RETURN
-   END SELECT
-
-!~~~>  CALL Rosenbrock method
-   CALL ros_Integrator(Y,Tstart,Tend,Texit,      &
-        AbsTol, RelTol,                          &
-!  Rosenbrock method coefficients
-        ros_S, ros_M, ros_E, ros_A, ros_C,       &
-        ros_Alpha, ros_Gamma, ros_ELO, ros_NewF, &
-!  Integration parameters
-        Autonomous, VectorTol, Max_no_steps,     &
-        Roundoff, Hmin, Hmax, Hstart, Hexit,     &
-        FacMin, FacMax, FacRej, FacSafe,         &
-!  Error indicator
-        IERR)
-
-
-!~~~>  Collect run statistics
-   ISTATUS(ifun) = Nfun
-   ISTATUS(ijac) = Njac
-   ISTATUS(istp) = Nstp
-   ISTATUS(iacc) = Nacc
-   ISTATUS(irej) = Nrej
-   ISTATUS(idec) = Ndec
-   ISTATUS(isol) = Nsol
-   ISTATUS(isng) = Nsng
-!~~~> Last T and H
-   RSTATUS(itexit) = Texit
-   RSTATUS(ihexit) = Hexit
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-CONTAINS !  SUBROUTINES internal to Rosenbrock
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- SUBROUTINE ros_ErrorMsg(Code,T,H,IERR)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!    Handles all error messages
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-   REAL(kind=dp), INTENT(IN) :: T, H
-   INTEGER, INTENT(IN)  :: Code
-   INTEGER, INTENT(OUT) :: IERR
-
-   IERR = Code
-   PRINT * , &
-     'Forced exit from Rosenbrock due to the following error:'
-   IF ((Code>=-8).AND.(Code<=-1)) THEN
-     PRINT *, IERR_NAMES(Code)
-   ELSE
-     PRINT *, 'Unknown Error code: ', Code
-   ENDIF
-
-   PRINT *, "T=", T, "and H=", H
-
- END SUBROUTINE ros_ErrorMsg
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- SUBROUTINE ros_Integrator (Y, Tstart, Tend, Tout,     &
-        AbsTol, RelTol,                          &
-!~~~> Rosenbrock method coefficients
-        ros_S, ros_M, ros_E, ros_A, ros_C,       &
-        ros_Alpha, ros_Gamma, ros_ELO, ros_NewF, &
-!~~~> Integration parameters
-        Autonomous, VectorTol, Max_no_steps,     &
-        Roundoff, Hmin, Hmax, Hstart, Hexit,     &
-        FacMin, FacMax, FacRej, FacSafe,         &
-!~~~> Error indicator
-        IERR )
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!   Template for the implementation of a generic Rosenbrock method
-!      defined by ros_S (no of stages)
-!      and its coefficients ros_{A,C,M,E,Alpha,Gamma}
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-  USE      messy_kpp_compress,         ONLY: kco_initialize, kco_compress, &
-                                             kco_finalize, cell_done
-  IMPLICIT NONE
-
-!~~~> Input: the initial condition at Tstart; Output: the solution at T
-   REAL(kind=dp), INTENT(INOUT) :: Y(:,:)
-!~~~> Input: integration interval
-   REAL(kind=dp), INTENT(IN) :: Tstart,Tend
-!~~~> Output: time at which the solution is returned (T=Tend if success)
-   REAL(kind=dp), INTENT(OUT) ::  Tout
-!~~~> Input: tolerances
-   REAL(kind=dp), INTENT(IN) ::  AbsTol(NVAR), RelTol(NVAR)
-!~~~> Input: The Rosenbrock method parameters
-   INTEGER, INTENT(IN) ::  ros_S
-   REAL(kind=dp), INTENT(IN) :: ros_M(ros_S), ros_E(ros_S),  &
-       ros_Alpha(ros_S), ros_A(ros_S*(ros_S-1)/2), &
-       ros_Gamma(ros_S), ros_C(ros_S*(ros_S-1)/2), ros_ELO
-   LOGICAL, INTENT(IN) :: ros_NewF(ros_S)
-!~~~> Input: integration parameters
-   LOGICAL, INTENT(IN) :: Autonomous, VectorTol
-   REAL(kind=dp), INTENT(IN) :: Hstart, Hmin, Hmax
-   INTEGER, INTENT(IN) :: Max_no_steps
-   REAL(kind=dp), INTENT(IN) :: Roundoff, FacMin, FacMax, FacRej, FacSafe
-!~~~> Output: last accepted step
-   REAL(kind=dp), INTENT(OUT) :: Hexit
-!~~~> Output: Error indicator
-   INTEGER, INTENT(OUT) :: IERR
-! ~~~~ Local variables
-   REAL(kind=dp) :: Ynew(VL_DIM,NVAR), Fcn0(VL_DIM,NVAR), Fcn(VL_DIM,NVAR)
-   REAL(kind=dp) :: K(VL_DIM,NVAR*ros_S)
-   REAL(kind=dp) :: Jac0(VL_DIM,LU_NONZERO), Ghimj(VL_DIM,LU_NONZERO)
-   REAL(kind=dp) :: Yerr(VL_DIM,NVAR)
-
-!~~~>  Local parameters
-   INTEGER :: ioffset, i, j, istage
-   REAL(kind=dp), PARAMETER :: ZERO = 0.0_dp, ONE  = 1.0_dp
-   REAL(kind=dp), PARAMETER :: DeltaMin = 1.0E-5_dp
-!~~~>  Locally called functions
-!    REAL(kind=dp) WLAMCH
-!    EXTERNAL WLAMCH
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-   real(kind=dp)                  :: deltat
-!kk   logical,parameter              :: fixed_step=.true.
-   
-   integer,save             :: icount=0
-
-!  vector compression algorithm
-
-   REAL(kind=dp), dimension(VL_dim)      :: T
-   REAL(kind=dp), dimension(VL_dim)      :: H, Hnew, HC, HC2, HG, Fac, Tau, Err
-   LOGICAL, dimension(VL_dim)            :: RejectLastH, RejectMoreH
-   LOGICAL, dimension(VL_dim)            :: Accept_step, error_flag
-   integer                               :: vl_save
-
-   REAL(kind=dp), dimension(size(FIX,1),size(FIX,2))      :: FIX_lo
-
-!~~~>  Initial preparations
-   T(1:VL)  = Tstart
-   Hexit    = 0.0_dp
-   H(1:VL)  = MIN(Hstart,Hmax)
-   Tout     = Tend
-   icount   = icount+1
-   where (ABS(H(1:VL)) <= 10.0_dp*Roundoff) H(1:VL) = DeltaMin
-
-   deltat=Tend-Tstart
-
-   RejectLastH(1:VL)=.FALSE.
-   RejectMoreH(1:VL)=.FALSE.
-
-!~~~> Time loop begins below
-
-   Nstp       = 0
-   error_flag(1:VL) = .false.
-   vl_save          = VL
-   FIX_lo(1:VL,:)   = FIX(1:VL,:)
-   Kacc(1:VL)       = 0
-   Krej(1:VL)       = 0
-
-!  intialize compression algorithm
-
-   IF (.not. l_fixed_step) then
-     if( return_A ) then
-       call kco_initialize (VL, y, Kacc, Krej, a=a)
-     else
-       call kco_initialize (VL, y, Kacc, Krej)
-     end if 
-   end if
-
-TimeLoop: DO 
-
-   IF ( Nstp > Max_no_steps ) THEN  ! Too many steps
-      CALL ros_ErrorMsg(-6,T(1),H(1),IERR)
-! mz_pj_20070514: replace 'call abort()' by
-!     error_flag(1:VL) = .TRUE.
-! NOTE: Nstp is the maximum number of steps of the remaining current vector
-      call abort()                                   !Vorlaeufig
-      RETURN
-   END IF
-   
-   Where ( (T(1:VL)+0.1_dp*H(1:VL)) == T(1:VL))      ! Step size too small
-      error_flag(1:VL) = .TRUE.  
-   endwhere
-
-   if( any(error_flag))  then
-      CALL ros_ErrorMsg(-7,T(1),H(1),IERR)
-      call abort()                                   !Vorlaeufig
-      RETURN
-   end if
-
-!~~~>  Limit H if necessary to avoid going beyond Tend
-!kk   Hexit = H
-   H(1:VL) = MIN(H(1:VL),ABS(Tend-T(1:VL)))
-
-!~~~>   Compute the function at current time
-   CALL Fun( Y, FIX_lo, RCONST, Fcn0)
-
-
-!~~~>   Compute the Jacobian at current time
-   CALL Jac_SP( Y, FIX_lo, RCONST, Jac0)
-
-
-!~~~>  Repeat step calculation until current step accepted
-
-   CALL ros_PrepareMatrix(H,ros_Gamma(1), Jac0,Ghimj)
-
-!~~~>   Compute the stages
-Stage: DO istage = 1, ros_S
-
-      ! Current istage offset. Current istage vector is K(ioffset+1:ioffset+NVAR)
-       ioffset = NVAR*(istage-1)
-
-      ! For the 1st istage the function has been computed previously
-       IF ( istage == 1 ) THEN
-         Fcn(1:VL,1:NVAR) = Fcn0(1:VL,1:NVAR) 
-      ! istage>1 and a new function evaluation is needed at the current istage
-       ELSEIF ( ros_NewF(istage) ) THEN
-         select case (istage-1)
-          case (1)
-           Ynew(1:VL,1:NVAR) = Y(1:VL,1:NVAR)
-           Ynew(1:VL,1:NVAR) = Ynew(1:VL,1:NVAR) +  K(1:VL,NVAR*(1- 1)+ 1:NVAR*1) &
-                        *ros_A((istage-1)*(istage-2)/2+ 1)
-          case (2)
-           Ynew(1:VL,1:NVAR) = Y(1:VL,1:NVAR)
-           Ynew(1:VL,1:NVAR) = Ynew(1:VL,1:NVAR) +  K(1:VL,NVAR*(2- 1)+ 1:NVAR*2) &
-                        *ros_A((istage-1)*(istage-2)/2+ 2)
-           Ynew(1:VL,1:NVAR) = Ynew(1:VL,1:NVAR) +  K(1:VL,NVAR*(2- 1)+ 1:NVAR*2) &
-                        *ros_A((istage-1)*(istage-2)/2+ 2)
-          case DEFAULT
-           Ynew(1:VL,1:NVAR) = Y(1:VL,1:NVAR)
-           DO j = 1, istage-1
-             Ynew(1:VL,1:NVAR) = Ynew(1:VL,1:NVAR) +  K(1:VL,NVAR*(j- 1)+ 1:NVAR*j) &
-                          *ros_A((istage-1)*(istage-2)/2+ j)
-           END DO
-         end select
-
-         CALL Fun( Ynew, FIX_lo, RCONST, Fcn)
-       END IF ! if istage == 1 elseif ros_NewF(istage)
-
-       select case (istage-1)
-        case (1)
-         K(1:VL,ioffset+ 1:ioffset+ NVAR) = Fcn(1:VL,1:NVAR)
-         j = 1
-         HC(1:VL) = ros_C((istage-1)*(istage-2)/2+ j)/(H(1:VL))
-         do i=1,NVAR
-           K(1:VL,ioffset+ i) = K(1:VL,ioffset+ i) +  K(1:VL,NVAR*(j- 1)+ i) *HC(1:VL)
-         end do
-        case (2)
-         K(1:VL,ioffset+ 1:ioffset+ NVAR) = Fcn(1:VL,1:NVAR)
-         HC(1:VL)  = ros_C((istage-1)*(istage-2)/2+ 1)/(H(1:VL))
-         HC2(1:VL) = ros_C((istage-1)*(istage-2)/2+ 2)/(H(1:VL))
-         do i=1,NVAR
-           K(1:VL,ioffset+ i) = K(1:VL,ioffset+ i) +  K(1:VL,NVAR*(1- 1)+ i) *HC(1:VL)
-           K(1:VL,ioffset+ i) = K(1:VL,ioffset+ i) +  K(1:VL,NVAR*(2- 1)+ i) *HC2(1:VL)
-         end do
-        case DEFAULT
-         K(1:VL,ioffset+ 1:ioffset+ NVAR) = Fcn(1:VL,1:NVAR)
-         DO j = 1, istage-1
-           HC(1:VL) = ros_C((istage-1)*(istage-2)/2+ j)/(H(1:VL))
-           do i=1,NVAR
-             K(1:VL,ioffset+ i) = K(1:VL,ioffset+ i) +  K(1:VL,NVAR*(j- 1)+ i) *HC(1:VL)
-           end do
-         END DO
-       end select
-
-       CALL ros_Solve(Ghimj, K(:,ioffset+1:ioffset+NVAR))
-
-   END DO Stage
-
-
-   if(ros_S == 3)   then
-     YNEW(1:VL,1:NVAR) = Y(1:VL,1:NVAR)
-     Yerr(1:VL,1:NVAR) = ZERO
-
-!~~~>  Compute the new solution
-     Ynew(1:VL,1:NVAR) = Ynew(1:VL,1:NVAR) + K(1:VL,NVAR*(1-1)+1:NVAR*1) * ros_m(1)
-     Ynew(1:VL,1:NVAR) = Ynew(1:VL,1:NVAR) + K(1:VL,NVAR*(2-1)+1:NVAR*2) * ros_m(2)
-     Ynew(1:VL,1:NVAR) = Ynew(1:VL,1:NVAR) + K(1:VL,NVAR*(3-1)+1:NVAR*3) * ros_m(3)
-
-!~~~>  Compute the error estimation
-
-     Yerr(1:VL,1:NVAR) = Yerr(1:VL,1:NVAR) + K(1:VL,NVAR*(1-1)+1:NVAR*1) * ros_E(1)
-     Yerr(1:VL,1:NVAR) = Yerr(1:VL,1:NVAR) + K(1:VL,NVAR*(2-1)+1:NVAR*2) * ros_E(2)
-     Yerr(1:VL,1:NVAR) = Yerr(1:VL,1:NVAR) + K(1:VL,NVAR*(3-1)+1:NVAR*3) * ros_E(3)
-   else
-     YNEW(1:VL,1:NVAR) = Y(1:VL,1:NVAR)
-     Yerr(1:VL,1:NVAR) = ZERO
-     DO j=1,ros_S
-!~~~>  Compute the new solution
-         Ynew(1:VL,1:NVAR) = Ynew(1:VL,1:NVAR) + &
-                        K(1:VL,NVAR*(j-1)+1:NVAR*j) * ros_m(j)
-
-!~~~>  Compute the error estimation
-
-       Yerr(1:VL,1:NVAR) = Yerr(1:VL,1:NVAR) + &
-                    K(1:VL,NVAR*(j-1)+1:NVAR*j) * ros_E(j)
-     END DO
-   end if
-
-
-!~~~>  Check the error magnitude and adjust step size
-   Nstp = Nstp+1
-
-   if(l_fixed_step)   then
-     Err  = 0.0
-     H    = t_steps(Nstp)*deltat
-     Hnew = t_steps(Nstp)*deltat
-   else
-     Err(1:VL) = ros_ErrorNorm ( Y, Ynew, Yerr, AbsTol, RelTol, VectorTol )
-!~~~> New step size is bounded by FacMin <= Hnew/H <= FacMax
-     where(Err(1:VL) >= 10.0_dp*Roundoff)
-       Fac(1:VL)  = MIN(FacMax,MAX(FacMin,FacSafe/Err(1:VL)**(ONE/ros_ELO)))
-     elsewhere
-       Fac(1:VL)  = 1000.                        !Force large time step
-     endwhere
-     Hnew(1:VL) = H(1:VL)*Fac(1:VL)
-   end if
-
-   Accept_step(1:VL) = (Err(1:VL) <= ONE).OR.(H(1:VL) <= Hmin)
-   where (Accept_step(1:VL))
-      Kacc(1:VL) = Kacc(1:VL)+1
-      T(1:VL) = T(1:VL) + H(1:VL)
-      Hnew(1:VL) = MAX(Hmin,MIN(Hnew(1:VL),Hmax))
-   endwhere
-   do i=1,NVAR
-     where (Accept_step(1:VL))
-       Y(1:VL,i) = MAX(Ynew(1:VL,i),ZERO)
-     endwhere
-   end do
-   where (Accept_step(1:VL) .and. RejectLastH(1:VL))
-      Hnew(1:VL) = MIN(Hnew(1:VL),H(1:VL))
-   endwhere
-   where (Accept_step(1:VL))
-      RejectLastH(1:VL) = .FALSE.
-      RejectMoreH(1:VL) = .FALSE.
-      H(1:VL) = Hnew(1:VL)
-   endwhere
-!kk   ELSE           !~~~> Reject step
-   where (.NOT. Accept_step(1:VL) .and. RejectMoreH(1:VL))
-      Hnew(1:VL) = H(1:VL)*FacRej
-   endwhere
-   where (.NOT. Accept_step(1:VL))
-      RejectMoreH(1:VL) = RejectLastH(1:VL)
-      RejectLastH(1:VL) = .TRUE.
-      H(1:VL) = Hnew(1:VL)
-   endwhere
-   where ( .NOT. Accept_step(1:VL) .and. Kacc(1:VL) >= 1)
-      Krej(1:VL) = Krej(1:VL)+1
-   endwhere
-
-
-   if(l_fixed_step)   then
-      if(Nstp >= Nfsteps) EXIT
-   else
-     cell_done(1:VL) = ( .NOT. (T(1:VL)-Tend)+Roundoff <= ZERO  )  
-     call kco_compress (VL, T, H, Hnew, error_flag, y, RCONST, FIX_lo,         &
-                                     RejectLastH, RejectMoreH, Kacc, Krej, a=a)
-     if(VL == 0)   EXIT
-   end if
-
-!kk   write(0,*) '  aaa ',icount,Nstp,count(cell_done),count(Accept_step),VL,minval(T)
-   END DO TimeLoop
-
-!~~~> Succesful exit
-   IERR = 1  !~~~> The integration was successful
-
-   IF (.not. l_fixed_step) then
-     call kco_finalize (y, Kacc, Krej, a=a)
-   end if
-
-   VL = VL_save
-
-!kk   write(0,*) 'bbb ',icount,Nstp,maxval(Kacc),maxval(Krej)
-!kk   if(icount >= 10)  call abort()
-
-  END SUBROUTINE ros_Integrator
-
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  FUNCTION ros_ErrorNorm ( Y, Ynew, Yerr, &
-               AbsTol, RelTol, VectorTol )
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!~~~> Computes the "scaled norm" of the error vector Yerr
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-   IMPLICIT NONE
-
-! Input arguments
-   REAL(kind=dp), INTENT(IN) :: Y(:,:), Ynew(:,:), &
-          Yerr(:,:), AbsTol(NVAR), RelTol(NVAR)
-   LOGICAL, INTENT(IN) ::  VectorTol
-! Local variables
-   REAL(kind=dp), dimension(VL)       :: Err, Scale, Ymax
-   INTEGER  :: i
-   REAL(kind=dp), PARAMETER           :: ZERO = 0.0_dp
-   REAL(kind=dp), dimension(VL)       :: ros_ErrorNorm
-
-   Err = ZERO
-   DO i=1,NVAR
-     Ymax = MAX( ABS(Y(1:VL,i)),ABS(Ynew(1:VL,i)))
-     IF (VectorTol) THEN
-       Scale = AbsTol(i)+ RelTol(i)*Ymax
-     ELSE
-       Scale = AbsTol(1)+ RelTol(1)*Ymax
-     END IF
-     Err = Err+ (Yerr(1:VL,i)/Scale)**2
-   END DO
-   Err  = SQRT(Err/NVAR)
-
-   ros_ErrorNorm = Err
-
-  END FUNCTION ros_ErrorNorm
-
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-  SUBROUTINE ros_PrepareMatrix ( H, gam, Jac0, Ghimj )
-
-! --- --- --- --- --- --- --- --- --- --- --- --- ---
-!  Prepares the LHS matrix for stage calculations
-!  1.  Construct Ghimj = 1/(H*ham) - Jac0
-!      "(Gamma H) Inverse Minus Jacobian"
-!  2.  Repeat LU decomposition of Ghimj until successful.
-!       -half the step size if LU decomposition fails and retry
-!       -exit after 5 consecutive fails
-! --- --- --- --- --- --- --- --- --- --- --- --- ---
-   IMPLICIT NONE
-
-!~~~> Input arguments
-   REAL(kind=dp), INTENT(IN) ::  Jac0(:,:)
-   REAL(kind=dp), INTENT(IN) ::  gam
-!~~~> Output arguments
-   REAL(kind=dp), INTENT(OUT) :: Ghimj(:,:)
-!~~~> Inout arguments
-   REAL(kind=dp), INTENT(INOUT) :: H(:)   ! step size is decreased when LU fails
-!~~~> Local variables
-   INTEGER  :: i, ising, Nconsecutive
-   REAL(kind=dp), dimension(size(H)) :: ghinv
-   REAL(kind=dp), PARAMETER :: ONE  = 1.0_dp, HALF = 0.5_dp
-
-   Nconsecutive = 0
-
-
-!~~~>    Construct Ghimj = 1/(H*gam) - Jac0
-   Ghimj(1:VL,1:LU_NONZERO) = -ONE * JAC0(1:VL,1:LU_NONZERO)
-   ghinv(1:VL) = ONE/(H(1:VL)*gam)
-   DO i=1,NVAR
-     Ghimj(1:VL,LU_DIAG(i)) = Ghimj(1:VL,LU_DIAG(i))+ghinv(1:VL)
-   END DO
-
-!~~~>    Compute LU decomposition
-!CDIR noiexpand
-   CALL KppDecomp( Ghimj, ising )
-
-   Ndec = Ndec + VL
-
-  END SUBROUTINE ros_PrepareMatrix
-
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  SUBROUTINE ros_Solve( A, b )
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!  Template for the forward/backward substitution (using pre-computed LU decomposition)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-   IMPLICIT NONE
-!~~~> Input variables
-   REAL(kind=dp), INTENT(IN)         :: A(:,:)
-!~~~> InOut variables
-   REAL(kind=dp), INTENT(INOUT)      :: b(:,:)
-
-   CALL KppSolve( A, b )
-
-   Nsol = Nsol+VL
-
-  END SUBROUTINE ros_Solve
-
-
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  SUBROUTINE Ros2 (ros_S,ros_A,ros_C,ros_M,ros_E,ros_Alpha,&
-            ros_Gamma,ros_NewF,ros_ELO,ros_Name)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-! --- AN L-STABLE METHOD, 2 stages, order 2
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-  IMPLICIT NONE
-
-   INTEGER, PARAMETER :: S=2
-   INTEGER, INTENT(OUT) ::  ros_S
-   REAL(kind=dp), DIMENSION(S), INTENT(OUT) :: ros_M,ros_E,ros_Alpha,ros_Gamma
-   REAL(kind=dp), DIMENSION(S*(S-1)/2), INTENT(OUT) :: ros_A, ros_C
-   REAL(kind=dp), INTENT(OUT) :: ros_ELO
-   LOGICAL, DIMENSION(S), INTENT(OUT) :: ros_NewF
-   CHARACTER(LEN=12), INTENT(OUT) :: ros_Name
-   DOUBLE PRECISION g
-
-    g = 1.0_dp + 1.0_dp/SQRT(2.0_dp)
-
-!~~~> Name of the method
-    ros_Name = 'ROS-2'
-!~~~> Number of stages
-    ros_S = S
-
-!~~~> The coefficient matrices A and C are strictly lower triangular.
-!   The lower triangular (subdiagonal) elements are stored in row-wise order:
-!   A(2,1) = ros_A(1), A(3,1)=ros_A(2), A(3,2)=ros_A(3), etc.
-!   The general mapping formula is:
-!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j )
-!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j )
-
-    ros_A(1) = (1.0_dp)/g
-    ros_C(1) = (-2.0_dp)/g
-!~~~> Does the stage i require a new function evaluation (ros_NewF(i)=TRUE)
-!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i)=FALSE)
-    ros_NewF(1) = .TRUE.
-    ros_NewF(2) = .TRUE.
-!~~~> M_i = Coefficients for new step solution
-    ros_M(1)= (3.0_dp)/(2.0_dp*g)
-    ros_M(2)= (1.0_dp)/(2.0_dp*g)
-! E_i = Coefficients for error estimator
-    ros_E(1) = 1.0_dp/(2.0_dp*g)
-    ros_E(2) = 1.0_dp/(2.0_dp*g)
-!~~~> ros_ELO = estimator of local order - the minimum between the
-!    main and the embedded scheme orders plus one
-    ros_ELO = 2.0_dp
-!~~~> Y_stage_i ~ Y( T + H*Alpha_i )
-    ros_Alpha(1) = 0.0_dp
-    ros_Alpha(2) = 1.0_dp
-!~~~> Gamma_i = \sum_j  gamma_{i,j}
-    ros_Gamma(1) = g
-    ros_Gamma(2) =-g
-
- END SUBROUTINE Ros2
-
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  SUBROUTINE Ros3 (ros_S,ros_A,ros_C,ros_M,ros_E,ros_Alpha,&
-           ros_Gamma,ros_NewF,ros_ELO,ros_Name)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-! --- AN L-STABLE METHOD, 3 stages, order 3, 2 function evaluations
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-  IMPLICIT NONE
-
-   INTEGER, PARAMETER :: S=3
-   INTEGER, INTENT(OUT) ::  ros_S
-   REAL(kind=dp), DIMENSION(S), INTENT(OUT) :: ros_M,ros_E,ros_Alpha,ros_Gamma
-   REAL(kind=dp), DIMENSION(S*(S-1)/2), INTENT(OUT) :: ros_A, ros_C
-   REAL(kind=dp), INTENT(OUT) :: ros_ELO
-   LOGICAL, DIMENSION(S), INTENT(OUT) :: ros_NewF
-   CHARACTER(LEN=12), INTENT(OUT) :: ros_Name
-
-!~~~> Name of the method
-   ros_Name = 'ROS-3'
-!~~~> Number of stages
-   ros_S = S
-
-!~~~> The coefficient matrices A and C are strictly lower triangular.
-!   The lower triangular (subdiagonal) elements are stored in row-wise order:
-!   A(2,1) = ros_A(1), A(3,1)=ros_A(2), A(3,2)=ros_A(3), etc.
-!   The general mapping formula is:
-!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j )
-!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j )
-
-   ros_A(1)= 1.0_dp
-   ros_A(2)= 1.0_dp
-   ros_A(3)= 0.0_dp
-
-   ros_C(1) = -0.10156171083877702091975600115545E+01_dp
-   ros_C(2) =  0.40759956452537699824805835358067E+01_dp
-   ros_C(3) =  0.92076794298330791242156818474003E+01_dp
-!~~~> Does the stage i require a new function evaluation (ros_NewF(i)=TRUE)
-!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i)=FALSE)
-   ros_NewF(1) = .TRUE.
-   ros_NewF(2) = .TRUE.
-   ros_NewF(3) = .FALSE.
-!~~~> M_i = Coefficients for new step solution
-   ros_M(1) =  0.1E+01_dp
-   ros_M(2) =  0.61697947043828245592553615689730E+01_dp
-   ros_M(3) = -0.42772256543218573326238373806514E+00_dp
-! E_i = Coefficients for error estimator
-   ros_E(1) =  0.5E+00_dp
-   ros_E(2) = -0.29079558716805469821718236208017E+01_dp
-   ros_E(3) =  0.22354069897811569627360909276199E+00_dp
-!~~~> ros_ELO = estimator of local order - the minimum between the
-!    main and the embedded scheme orders plus 1
-   ros_ELO = 3.0_dp
-!~~~> Y_stage_i ~ Y( T + H*Alpha_i )
-   ros_Alpha(1)= 0.0E+00_dp
-   ros_Alpha(2)= 0.43586652150845899941601945119356E+00_dp
-   ros_Alpha(3)= 0.43586652150845899941601945119356E+00_dp
-!~~~> Gamma_i = \sum_j  gamma_{i,j}
-   ros_Gamma(1)= 0.43586652150845899941601945119356E+00_dp
-   ros_Gamma(2)= 0.24291996454816804366592249683314E+00_dp
-   ros_Gamma(3)= 0.21851380027664058511513169485832E+01_dp
-
-  END SUBROUTINE Ros3
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  SUBROUTINE Ros4 (ros_S,ros_A,ros_C,ros_M,ros_E,ros_Alpha,&
-           ros_Gamma,ros_NewF,ros_ELO,ros_Name)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!     L-STABLE ROSENBROCK METHOD OF ORDER 4, WITH 4 STAGES
-!     L-STABLE EMBEDDED ROSENBROCK METHOD OF ORDER 3
-!
-!      E. HAIRER AND G. WANNER, SOLVING ORDINARY DIFFERENTIAL
-!      EQUATIONS II. STIFF AND DIFFERENTIAL-ALGEBRAIC PROBLEMS.
-!      SPRINGER SERIES IN COMPUTATIONAL MATHEMATICS,
-!      SPRINGER-VERLAG (1990)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-  IMPLICIT NONE
-
-   INTEGER, PARAMETER :: S=4
-   INTEGER, INTENT(OUT) ::  ros_S
-   REAL(kind=dp), DIMENSION(4), INTENT(OUT) :: ros_M,ros_E,ros_Alpha,ros_Gamma
-   REAL(kind=dp), DIMENSION(6), INTENT(OUT) :: ros_A, ros_C
-   REAL(kind=dp), INTENT(OUT) :: ros_ELO
-   LOGICAL, DIMENSION(4), INTENT(OUT) :: ros_NewF
-   CHARACTER(LEN=12), INTENT(OUT) :: ros_Name
-   DOUBLE PRECISION g
-
-!~~~> Name of the method
-   ros_Name = 'ROS-4'
-!~~~> Number of stages
-   ros_S = S
-
-!~~~> The coefficient matrices A and C are strictly lower triangular.
-!   The lower triangular (subdiagonal) elements are stored in row-wise order:
-!   A(2,1) = ros_A(1), A(3,1)=ros_A(2), A(3,2)=ros_A(3), etc.
-!   The general mapping formula is:
-!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j )
-!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j )
-
-   ros_A(1) = 0.2000000000000000E+01_dp
-   ros_A(2) = 0.1867943637803922E+01_dp
-   ros_A(3) = 0.2344449711399156E+00_dp
-   ros_A(4) = ros_A(2)
-   ros_A(5) = ros_A(3)
-   ros_A(6) = 0.0_dp
-
-   ros_C(1) =-0.7137615036412310E+01_dp
-   ros_C(2) = 0.2580708087951457E+01_dp
-   ros_C(3) = 0.6515950076447975E+00_dp
-   ros_C(4) =-0.2137148994382534E+01_dp
-   ros_C(5) =-0.3214669691237626E+00_dp
-   ros_C(6) =-0.6949742501781779E+00_dp
-!~~~> Does the stage i require a new function evaluation (ros_NewF(i)=TRUE)
-!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i)=FALSE)
-   ros_NewF(1)  = .TRUE.
-   ros_NewF(2)  = .TRUE.
-   ros_NewF(3)  = .TRUE.
-   ros_NewF(4)  = .FALSE.
-!~~~> M_i = Coefficients for new step solution
-   ros_M(1) = 0.2255570073418735E+01_dp
-   ros_M(2) = 0.2870493262186792E+00_dp
-   ros_M(3) = 0.4353179431840180E+00_dp
-   ros_M(4) = 0.1093502252409163E+01_dp
-!~~~> E_i  = Coefficients for error estimator
-   ros_E(1) =-0.2815431932141155E+00_dp
-   ros_E(2) =-0.7276199124938920E-01_dp
-   ros_E(3) =-0.1082196201495311E+00_dp
-   ros_E(4) =-0.1093502252409163E+01_dp
-!~~~> ros_ELO  = estimator of local order - the minimum between the
-!    main and the embedded scheme orders plus 1
-   ros_ELO  = 4.0_dp
-!~~~> Y_stage_i ~ Y( T + H*Alpha_i )
-   ros_Alpha(1) = 0.0_dp
-   ros_Alpha(2) = 0.1145640000000000E+01_dp
-   ros_Alpha(3) = 0.6552168638155900E+00_dp
-   ros_Alpha(4) = ros_Alpha(3)
-!~~~> Gamma_i = \sum_j  gamma_{i,j}
-   ros_Gamma(1) = 0.5728200000000000E+00_dp
-   ros_Gamma(2) =-0.1769193891319233E+01_dp
-   ros_Gamma(3) = 0.7592633437920482E+00_dp
-   ros_Gamma(4) =-0.1049021087100450E+00_dp
-
-  END SUBROUTINE Ros4
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  SUBROUTINE Rodas3 (ros_S,ros_A,ros_C,ros_M,ros_E,ros_Alpha,&
-            ros_Gamma,ros_NewF,ros_ELO,ros_Name)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-! --- A STIFFLY-STABLE METHOD, 4 stages, order 3
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-  IMPLICIT NONE
-
-   INTEGER, PARAMETER :: S=4
-   INTEGER, INTENT(OUT) ::  ros_S
-   REAL(kind=dp), DIMENSION(S), INTENT(OUT) :: ros_M,ros_E,ros_Alpha,ros_Gamma
-   REAL(kind=dp), DIMENSION(S*(S-1)/2), INTENT(OUT) :: ros_A, ros_C
-   REAL(kind=dp), INTENT(OUT) :: ros_ELO
-   LOGICAL, DIMENSION(S), INTENT(OUT) :: ros_NewF
-   CHARACTER(LEN=12), INTENT(OUT) :: ros_Name
-   DOUBLE PRECISION g
-
-!~~~> Name of the method
-   ros_Name = 'RODAS-3'
-!~~~> Number of stages
-   ros_S = S
-
-!~~~> The coefficient matrices A and C are strictly lower triangular.
-!   The lower triangular (subdiagonal) elements are stored in row-wise order:
-!   A(2,1) = ros_A(1), A(3,1)=ros_A(2), A(3,2)=ros_A(3), etc.
-!   The general mapping formula is:
-!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j )
-!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j )
-
-   ros_A(1) = 0.0E+00_dp
-   ros_A(2) = 2.0E+00_dp
-   ros_A(3) = 0.0E+00_dp
-   ros_A(4) = 2.0E+00_dp
-   ros_A(5) = 0.0E+00_dp
-   ros_A(6) = 1.0E+00_dp
-
-   ros_C(1) = 4.0E+00_dp
-   ros_C(2) = 1.0E+00_dp
-   ros_C(3) =-1.0E+00_dp
-   ros_C(4) = 1.0E+00_dp
-   ros_C(5) =-1.0E+00_dp
-   ros_C(6) =-(8.0E+00_dp/3.0E+00_dp)
-
-!~~~> Does the stage i require a new function evaluation (ros_NewF(i)=TRUE)
-!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i)=FALSE)
-   ros_NewF(1)  = .TRUE.
-   ros_NewF(2)  = .FALSE.
-   ros_NewF(3)  = .TRUE.
-   ros_NewF(4)  = .TRUE.
-!~~~> M_i = Coefficients for new step solution
-   ros_M(1) = 2.0E+00_dp
-   ros_M(2) = 0.0E+00_dp
-   ros_M(3) = 1.0E+00_dp
-   ros_M(4) = 1.0E+00_dp
-!~~~> E_i  = Coefficients for error estimator
-   ros_E(1) = 0.0E+00_dp
-   ros_E(2) = 0.0E+00_dp
-   ros_E(3) = 0.0E+00_dp
-   ros_E(4) = 1.0E+00_dp
-!~~~> ros_ELO  = estimator of local order - the minimum between the
-!    main and the embedded scheme orders plus 1
-   ros_ELO  = 3.0E+00_dp
-!~~~> Y_stage_i ~ Y( T + H*Alpha_i )
-   ros_Alpha(1) = 0.0E+00_dp
-   ros_Alpha(2) = 0.0E+00_dp
-   ros_Alpha(3) = 1.0E+00_dp
-   ros_Alpha(4) = 1.0E+00_dp
-!~~~> Gamma_i = \sum_j  gamma_{i,j}
-   ros_Gamma(1) = 0.5E+00_dp
-   ros_Gamma(2) = 1.5E+00_dp
-   ros_Gamma(3) = 0.0E+00_dp
-   ros_Gamma(4) = 0.0E+00_dp
-
-  END SUBROUTINE Rodas3
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  SUBROUTINE Rodas4 (ros_S,ros_A,ros_C,ros_M,ros_E,ros_Alpha,&
-             ros_Gamma,ros_NewF,ros_ELO,ros_Name)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!     STIFFLY-STABLE ROSENBROCK METHOD OF ORDER 4, WITH 6 STAGES
-!
-!      E. HAIRER AND G. WANNER, SOLVING ORDINARY DIFFERENTIAL
-!      EQUATIONS II. STIFF AND DIFFERENTIAL-ALGEBRAIC PROBLEMS.
-!      SPRINGER SERIES IN COMPUTATIONAL MATHEMATICS,
-!      SPRINGER-VERLAG (1996)
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-  IMPLICIT NONE
-
-   INTEGER, PARAMETER :: S=6
-   INTEGER, INTENT(OUT) ::  ros_S
-   REAL(kind=dp), DIMENSION(S), INTENT(OUT) :: ros_M,ros_E,ros_Alpha,ros_Gamma
-   REAL(kind=dp), DIMENSION(S*(S-1)/2), INTENT(OUT) :: ros_A, ros_C
-   REAL(kind=dp), INTENT(OUT) :: ros_ELO
-   LOGICAL, DIMENSION(S), INTENT(OUT) :: ros_NewF
-   CHARACTER(LEN=12), INTENT(OUT) :: ros_Name
-   DOUBLE PRECISION g
-
-!~~~> Name of the method
-    ros_Name = 'RODAS-4'
-!~~~> Number of stages
-    ros_S = 6
-
-!~~~> Y_stage_i ~ Y( T + H*Alpha_i )
-    ros_Alpha(1) = 0.000_dp
-    ros_Alpha(2) = 0.386_dp
-    ros_Alpha(3) = 0.210_dp
-    ros_Alpha(4) = 0.630_dp
-    ros_Alpha(5) = 1.000_dp
-    ros_Alpha(6) = 1.000_dp
-
-!~~~> Gamma_i = \sum_j  gamma_{i,j}
-    ros_Gamma(1) = 0.2500000000000000E+00_dp
-    ros_Gamma(2) =-0.1043000000000000E+00_dp
-    ros_Gamma(3) = 0.1035000000000000E+00_dp
-    ros_Gamma(4) =-0.3620000000000023E-01_dp
-    ros_Gamma(5) = 0.0_dp
-    ros_Gamma(6) = 0.0_dp
-
-!~~~> The coefficient matrices A and C are strictly lower triangular.
-!   The lower triangular (subdiagonal) elements are stored in row-wise order:
-!   A(2,1) = ros_A(1), A(3,1)=ros_A(2), A(3,2)=ros_A(3), etc.
-!   The general mapping formula is:  A(i,j) = ros_A( (i-1)*(i-2)/2 + j )
-!                  C(i,j) = ros_C( (i-1)*(i-2)/2 + j )
-
-    ros_A(1) = 0.1544000000000000E+01_dp
-    ros_A(2) = 0.9466785280815826E+00_dp
-    ros_A(3) = 0.2557011698983284E+00_dp
-    ros_A(4) = 0.3314825187068521E+01_dp
-    ros_A(5) = 0.2896124015972201E+01_dp
-    ros_A(6) = 0.9986419139977817E+00_dp
-    ros_A(7) = 0.1221224509226641E+01_dp
-    ros_A(8) = 0.6019134481288629E+01_dp
-    ros_A(9) = 0.1253708332932087E+02_dp
-    ros_A(10) =-0.6878860361058950E+00_dp
-    ros_A(11) = ros_A(7)
-    ros_A(12) = ros_A(8)
-    ros_A(13) = ros_A(9)
-    ros_A(14) = ros_A(10)
-    ros_A(15) = 1.0E+00_dp
-
-    ros_C(1) =-0.5668800000000000E+01_dp
-    ros_C(2) =-0.2430093356833875E+01_dp
-    ros_C(3) =-0.2063599157091915E+00_dp
-    ros_C(4) =-0.1073529058151375E+00_dp
-    ros_C(5) =-0.9594562251023355E+01_dp
-    ros_C(6) =-0.2047028614809616E+02_dp
-    ros_C(7) = 0.7496443313967647E+01_dp
-    ros_C(8) =-0.1024680431464352E+02_dp
-    ros_C(9) =-0.3399990352819905E+02_dp
-    ros_C(10) = 0.1170890893206160E+02_dp
-    ros_C(11) = 0.8083246795921522E+01_dp
-    ros_C(12) =-0.7981132988064893E+01_dp
-    ros_C(13) =-0.3152159432874371E+02_dp
-    ros_C(14) = 0.1631930543123136E+02_dp
-    ros_C(15) =-0.6058818238834054E+01_dp
-
-!~~~> M_i = Coefficients for new step solution
-    ros_M(1) = ros_A(7)
-    ros_M(2) = ros_A(8)
-    ros_M(3) = ros_A(9)
-    ros_M(4) = ros_A(10)
-    ros_M(5) = 1.0E+00_dp
-    ros_M(6) = 1.0E+00_dp
-
-!~~~> E_i  = Coefficients for error estimator
-    ros_E(1) = 0.0E+00_dp
-    ros_E(2) = 0.0E+00_dp
-    ros_E(3) = 0.0E+00_dp
-    ros_E(4) = 0.0E+00_dp
-    ros_E(5) = 0.0E+00_dp
-    ros_E(6) = 1.0E+00_dp
-
-!~~~> Does the stage i require a new function evaluation (ros_NewF(i)=TRUE)
-!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i)=FALSE)
-    ros_NewF(1) = .TRUE.
-    ros_NewF(2) = .TRUE.
-    ros_NewF(3) = .TRUE.
-    ros_NewF(4) = .TRUE.
-    ros_NewF(5) = .TRUE.
-    ros_NewF(6) = .TRUE.
-
-!~~~> ros_ELO  = estimator of local order - the minimum between the
-!        main and the embedded scheme orders plus 1
-    ros_ELO = 4.0_dp
-
-  END SUBROUTINE Rodas4
-
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-!   End of the set of internal Rosenbrock subroutines
-!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-END SUBROUTINE Rosenbrock
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_cbm4/cbm4.eqn
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_cbm4/cbm4.eqn	(revision 3298)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_cbm4/cbm4.eqn	(revision 3298)
@@ -0,0 +1,113 @@
+#EQUATIONS {CBM4}
+
+{01:J01} NO2+hv=NO+O                          :  phot(j_no2)  ;
+{02:J02} O3+hv=O                              :  phot(j_o33p) ;
+{03:J03} O3+hv=O1D_CB4                        :  phot(j_o31d) ;
+{04:J04} NO3+hv=0.89 NO2+0.89 O+0.11 NO       :  phot(j_no3o)+phot(j_no3o2);
+{05:J05} HONO+hv=HO+NO                        :  phot(j_hono) ;
+{06:J06} H2O2+hv=2 HO                         :  phot(j_h2o2) ; 
+{07:J07} HCHO+hv{+2 O2}= 2 HO2+CO             :  phot(j_ch2or) ;
+{08:J08} HCHO+hv=CO                           :  phot(j_ch2om) ;
+{09:J09} ALD2+hv{+ 2 O2}=HCHO+XO2+CO+ 2 HO2   :  4.6E-4_dp*phot(j_no2) ; 
+{10:J10} OPEN+hv=C2O3+CO+HO2                  :  9.04_dp*phot(j_ch2or) ; 
+{11:J11} MGLY+hv=C2O3+CO+HO2                  :  9.64_dp*phot(j_ch2or) ; 
+{12:01} O{+O2+M}=O3                           :  arr2(1.4E+3_dp, -1175.0_dp, temp) ;
+{13:02} O3+NO=NO2                             :  arr2(1.8E-12_dp, +1370.0_dp, temp) ;
+{14:03} O+NO2=NO                              :  9.3E-12_dp ;
+{15:04} O+NO2=NO3                             :  arr2(1.6E-13_dp, -687.0_dp, temp) ;
+{16:05} O+NO=NO2                              :  arr2(2.2E-13_dp, -602.0_dp, temp) ;
+{17:06} O3+NO2=NO3                            :  arr2(1.2E-13_dp, +2450.0_dp, temp) ;
+{18:07} O1D_CB4=O                             :  arr2(1.9E+8_dp, -390.0_dp, temp)  ;
+{19:08} O1D_CB4+H2O=2HO                       :  2.2E-10_dp ;
+{20:09} O3+HO=HO2                             :  arr2(1.6E-12_dp, +940.0_dp, temp) ;
+{21:10} O3+HO2=HO                             :  arr2(1.4E-14_dp, +580.0_dp, temp) ;
+{22:11} NO3+NO=2 NO2                          :  arr2(1.3E-11_dp, -250.0_dp, temp) ;
+{23:12} NO3+NO2=NO+NO2                        :  arr2(2.5E-14_dp, +1230.0_dp, temp) ;
+{24:13} NO3+NO2=N2O5                          :  arr2(5.3E-13_dp, -256.0_dp, temp) ;
+{25:14} N2O5+H2O=2 HNO3                       :  1.3E-21_dp ;
+{26:15} N2O5=NO3+NO2                          :  arr2(3.5E+14_dp, +10897.0_dp, temp) ;
+{27:16} 2 NO=2 NO2                            :  arr2(1.8E-20_dp, -530.0_dp, temp) ;
+{28:17} NO+NO2+H2O=2 HONO                     :  4.4E-40_dp ;
+{29:18} HO+NO=HONO                            :  arr2(4.5E-13_dp, -806.0_dp, temp) ;
+{30:19} HO+HONO=NO2                           :  6.6E-12_dp ;
+{31:20} 2 HONO=NO+NO2                         :  1.0E-20_dp ;
+{32:21} HO+NO2=HNO3                           :  arr2(1.0E-12_dp, -713.0_dp, temp) ;
+{33:22} HO+HNO3=NO3                           :  arr2(5.1E-15_dp, -1000.0_dp, temp) ;
+{34:23} HO2+NO=HO+NO2                         :  arr2(3.7E-12_dp, -240.0_dp, temp) ;
+{35:24} HO2+NO2=PNA                           :  arr2(1.2E-13_dp, -749.0_dp, temp) ;
+{36:25} PNA=HO2+NO2                           :  arr2(4.8E+13_dp, +10121.0_dp, temp) ;
+{37:26} HO+PNA=NO2                            :  arr2(1.3E-12_dp, -380.0_dp, temp) ;
+{38:27} 2 HO2=H2O2                            :  arr2(5.9E-14_dp, -1150.0_dp, temp)  ;
+{39:28} 2 HO2+H2O=H2O2                        :  arr2(2.2E-38_dp, -5800.0_dp, temp) ;
+{40:29} HO+H2O2=HO2                           :  arr2(3.1E-12_dp, +187.0_dp, temp) ;
+{41:30} HO+CO=HO2                             :  2.2E-13_dp ;
+{42:31} HCHO+HO=HO2+CO                        :  1.0E-11_dp ;
+{43:32} HCHO+O=HO+HO2+CO                      :  arr2(3.0E-11_dp, +1550.0_dp, temp) ;
+{44:33} HCHO+NO3=HNO3+HO2+CO                  :  6.3E-16_dp ;
+{45:34} ALD2+O=C2O3+HO                        :  arr2(1.2E-11_dp, +986.0_dp, temp) ;
+{46:35} ALD2+HO=C2O3                          :  arr2(7.0E-12_dp, -250.0_dp, temp) ;
+{47:36} ALD2+NO3=C2O3+HNO3                    :  2.5E-15_dp  ;
+{48:37} C2O3+NO=HCHO+XO2+HO2+NO2              :  arr2(5.4E-12_dp, -250.0_dp, temp) ;
+{49:38} C2O3+NO2=PAN                          :  arr2(8.0E-20_dp, -5500.0_dp, temp) ;
+{50:39} PAN=C2O3+NO2                          :  arr2(9.4E+16_dp, +14000.0_dp, temp) ;
+{51:40} 2 C2O3=2 HCHO+2 XO2+2 HO2             :  2.0E-12_dp  ;
+{52:41} C2O3+HO2=0.79 HCHO+0.79 XO2
+                +0.79 HO2+0.79 HO             :  6.5E-12_dp ;
+{53:42} HO=HCHO+XO2+HO2                       :  arr2(1.1E+2_dp, +1710.0_dp, temp) ;
+{54:43} PAR+HO=0.87 XO2+0.13 XO2N
+              +0.11 HO2+0.11 ALD2
+              +0.76 ROR-0.11 PAR              :  8.1E-13_dp ;
+{55:44} ROR=1.1 ALD2+0.96 XO2
+           +0.94 HO2 +0.04 XO2N
+           +0.02 ROR-2.10 PAR                 :  arr2(1.0E+15_dp, +8000.0_dp, temp) ;
+{56:45} ROR=HO2                               :  1.6E+03_dp ;
+{57:46} ROR+NO2= PROD                         :  1.5E-11_dp  ;
+{58:47} O+OLE=0.63 ALD2+0.38 HO2
+             +0.28 XO2+0.3 CO
+             +0.2 HCHO+0.02 XO2N
+             +0.22 PAR+0.2 HO                 :  arr2(1.2E-11_dp, +324.0_dp, temp) ;
+{59:48} HO+OLE=HCHO+ALD2+XO2+HO2-PAR          :  arr2(5.2E-12_dp, -504.0_dp, temp) ;
+{60:49} O3+OLE=0.5 ALD2+0.74 HCHO
+              +0.33 CO+0.44 HO2
+              +0.22 XO2+0.1 HO-PAR            :  arr2(1.4E-14_dp, +2105.0_dp, temp)  ;
+{61:50} NO3+OLE=0.91 XO2+HCHO
+               +ALD2+0.09 XO2N
+               +NO2-PAR                       :  7.7E-15_dp ;
+{62:51} O+ETH=HCHO+0.7 XO2
+             +CO+1.7 HO2+0.3 HO               :  arr2(1.0E-11_dp, +792.0_dp, temp) ;
+{63:52} HO+ETH=XO2+1.56 HCHO
+              +HO2+0.22 ALD2                  :  arr2(2.0E-12_dp, -411.0_dp, temp) ;
+{64:53} O3+ETH=HCHO+0.42 CO+0.12 HO2          :  arr2(1.3E-14_dp, +2633.0_dp, temp) ;
+{65:54} HO+TOL=0.08 XO2+0.36 CRES
+              +0.44 HO2+0.56 TO2              :  arr2(2.1E-12_dp, -322.0_dp, temp) ;
+{66:55} TO2+NO=0.9 NO2+0.9 OPEN+0.9 HO2       :  8.1E-12_dp ;
+{67:56} TO2=HO2+CRES                          :  4.20_dp ;
+{68:57} HO+CRES=0.4 CRO+0.6 XO2
+               +0.6 HO2+0.3 OPEN              :  4.1E-11_dp  ;
+{69:58} NO3+CRES=CRO+HNO3                     :  2.2E-11_dp ;
+{70:59} CRO+NO2=PROD                          :  1.4E-11_dp ;
+{71:60} HO+XYL=0.7 HO2+0.5 XO2
+              +0.2 CRES+0.8 MGLY
+              +1.10 PAR+0.3 TO2               :  arr2(1.7E-11_dp, -116.0_dp, temp) ;
+{72:61} HO+OPEN=XO2+C2O3+2 HO2+2 CO+HCHO      :  3.0E-11_dp ;
+{73:62} O3+OPEN=0.03 ALD2+0.62 C2O3
+               +0.7 HCHO+0.03 XO2
+               +0.69 CO+0.08 HO
+               +0.76 HO2+0.2 MGLY             :  arr2(5.4E-17_dp, +500.0_dp, temp)  ;
+{74:63} HO+MGLY=XO2+C2O3                      :  1.70E-11_dp ;
+{75:64} O+ISOP=0.6 HO2+0.8 ALD2
+              +0.55 OLE+0.5 XO2
+              +0.5 CO+0.45 ETH
+              +0.9 PAR                        :  1.80E-11_dp  ;
+{76:65} HO+ISOP=HCHO+XO2
+               +0.67 HO2+0.4 MGLY
+               +0.2 C2O3+ETH
+               +0.2 ALD2+0.13 XO2N            :  9.6E-11_dp  ;
+{77:66} O3+ISOP=HCHO+0.4 ALD2
+               +0.55 ETH+0.2 MGLY
+               +0.06 CO+0.1 PAR
+               +0.44 HO2+0.1 HO               :  1.2E-17_dp ;
+{78:67} NO3+ISOP=XO2N                         :  3.2E-13_dp ;
+{79:68} XO2+NO=NO2                            :  8.1E-12_dp ;
+{80:69} 2 XO2=PROD                            :  arr2(1.7E-14_dp, -1300.0_dp, temp) ;
+{81:70} XO2N+NO=PROD                          :  6.8E-13_dp ;
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_cbm4/cbm4.spc
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_cbm4/cbm4.spc	(revision 3298)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_cbm4/cbm4.spc	(revision 3298)
@@ -0,0 +1,40 @@
+{cbm4.spc}
+
+#include atoms
+
+#DEFVAR
+ NO          = N + O ;       {nitric oxide}
+ NO2         = N + 2O ;      {nitrogen dioxide}
+ NO3         = N + 3O ;      {nitrogen trioxide}
+ N2O5        = 2N + 5O ;     {dinitrogen pentoxide}
+ HONO        = H + 2O + N ;  {nitrous acid}
+ HNO3        = H + N + 3O ;  { nitric acid }
+ PNA         = H + 4 O + N ; {HO2NO2 peroxynitric acid}
+ O1D_CB4     = O ;           {oxygen atomic first singlet state}
+ O           = O ;           {oxygen atomic ground state (3P)}
+ HO          = O + H ;       {hydroxyl radical}
+ O3          = 3O ;          {ozone}
+ HO2         = H + 2O ;      {perhydroxyl radical}
+ H2O2        = 2H + 2O ;     {hydrogen peroxide}
+ HCHO        = C + 2H + O ;  {formalydehyde}
+ ALD2        = IGNORE ;      {high molecular weight aldehides}
+ C2O3        = 2C + 3H + 3O ; {CH3CO(O)OO peroxyacyl radical}
+ PAN         = 2C + 3H + 5O + N ; {CH3C(O)OONO2, peroxyacyl nitrate}
+ PAR         = IGNORE ;      {parafin carbon bond}
+ ROR         = IGNORE ;      {secondary organic oxy radical}
+ OLE         = IGNORE ;      {olefinic carbon bond}
+ ETH         = 2C + 4H ;     {CH2=CH2 ethene}
+ TOL         = 7C + 8H ;     {C6H5-CH3 toluene}
+ CRES        = IGNORE ;      {cresol and h.m.w. phenols}
+ TO2         = IGNORE ;      {toluene-hydroxyl radical adduct}
+ CRO         = IGNORE ;      {methylphenoxy radical}
+ OPEN        = IGNORE ;      {h.m.w. aromatic oxidation ring fragment}
+ XYL         = 8C + 10H ;    {C6H4-(CH3)2 xylene}
+ MGLY        = 3C + 4H + 2O ; {CH3C(O)C(O)H methylglyoxal}
+ ISOP        = IGNORE ;      {isoprene}
+ XO2         = IGNORE ;      {NO-to-NO2 operation}
+ XO2N        = IGNORE ;      {NO-to-nitrate operation}          
+ CO          = C + O ;       {carbon monoxide}
+#DEFFIX
+ H2O = H + 2O ;      {water}
+
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_cbm4/chem_gasphase_mod.f90
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_cbm4/chem_gasphase_mod.f90	(revision 3298)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_cbm4/chem_gasphase_mod.f90	(revision 3298)
@@ -0,0 +1,4056 @@
+MODULE chem_gasphase_mod
+ 
+!   Mechanism: cbm4
+!
+!------------------------------------------------------------------------------!
+!
+! ******Module chem_gasphase_mod is automatically generated by kpp4palm ******
+!
+!   *********Please do NOT change this Code,it will be ovewritten *********
+!
+!------------------------------------------------------------------------------!
+! This file was created by KPP (http://people.cs.vt.edu/asandu/Software/Kpp/)
+! and kpp4palm (created by Klaus Ketelsen). kpp4palm is an adapted version 
+! of KP4 (JÃ¶ckel,P.,Kerkweg,A.,Pozzer,A.,Sander,R.,Tost,H.,Riede,
+! H.,Baumgaertner,A.,Gromov,S.,and Kern,B.,2010: Development cycle 2 of
+! the Modular Earth Submodel System (MESSy2),Geosci. Model Dev.,3,717-752,
+! https://doi.org/10.5194/gmd-3-717-2010). KP4 is part of the Modular Earth 
+! Submodel System (MESSy),which is is available under the  GNU General Public 
+! License (GPL).
+!
+! KPP is free software; you can redistribute it and/or modify it under the terms 
+! of the General Public Licence as published by the Free Software Foundation; 
+! either version 2 of the License,or (at your option) any later version. 
+! KPP is distributed in the hope that it will be useful,but WITHOUT ANY WARRANTY; 
+! without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 
+! PURPOSE. See the GNU General Public Licence for more details. 
+!
+!------------------------------------------------------------------------------!
+! This file is part of the PALM model system.
+!
+! PALM is free software: you can redistribute it and/or modify it under the
+! terms of the GNU General Public License as published by the Free Software
+! Foundation,either version 3 of the License,or (at your option) any later
+! version.
+!
+! PALM is distributed in the hope that it will be useful,but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not,see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2018 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! ------------------
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id: module_header 2460 2017-09-13 14:47:48Z forkel $
+! forkel June 2018: qvap,fakt added
+! forkel June 2018: reset case in  Initialize,Integrate,Update_rconst
+! 
+! 
+! 2460 2017-09-13 14:47:48Z forkel
+!
+! forkel Sept. 2017: Variables for photolyis added
+!
+!
+! Nov. 2016: Intial version (Klaus Ketelsen)
+!
+!------------------------------------------------------------------------------!
+!
+
+
+! Set kpp Double Precision to PALM Default Precision
+
+  USE kinds,           ONLY: dp=>wp
+
+  USE pegrid,          ONLY: myid, threads_per_task
+
+  IMPLICIT        NONE
+  PRIVATE
+  !SAVE  ! note: occurs again in automatically generated code ...
+
+!  PUBLIC :: IERR_NAMES
+ 
+! PUBLIC :: SPC_NAMES,EQN_NAMES,EQN_TAGS,REQ_HET,REQ_AEROSOL,REQ_PHOTRAT &
+!         ,REQ_MCFCT,IP_MAX,jname
+
+  PUBLIC :: eqn_names, phot_names, spc_names
+  PUBLIC :: nmaxfixsteps
+  PUBLIC :: atol, rtol
+  PUBLIC :: nspec, nreact
+  PUBLIC :: temp
+  PUBLIC :: qvap
+  PUBLIC :: fakt
+  PUBLIC :: phot 
+  PUBLIC :: rconst
+  PUBLIC :: nvar
+  PUBLIC :: nphot
+  PUBLIC :: vl_dim                     ! PUBLIC to ebable other MODULEs to distiguish between scalar and vec
+ 
+  PUBLIC :: initialize, integrate, update_rconst
+  PUBLIC :: chem_gasphase_integrate
+  PUBLIC :: initialize_kpp_ctrl
+
+! END OF MODULE HEADER TEMPLATE
+                                                                 
+! Variables used for vector mode                                 
+                                                                 
+  LOGICAL, PARAMETER          :: l_vector = .FALSE.            
+  INTEGER, PARAMETER          :: i_lu_di = 2
+  INTEGER, PARAMETER          :: vl_dim = 1
+  INTEGER                     :: vl                              
+                                                                 
+  INTEGER                     :: vl_glo                          
+  INTEGER                     :: is, ie                           
+                                                                 
+                                                                 
+  INTEGER, DIMENSION(vl_dim)  :: kacc, krej                       
+  INTEGER, DIMENSION(vl_dim)  :: ierrv                           
+  LOGICAL                     :: data_loaded = .FALSE.             
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Parameter Module File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Parameters.f90
+! Time                 : Tue Sep 25 18:35:13 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! NSPEC - Number of chemical species
+  INTEGER, PARAMETER :: nspec = 33 
+! NVAR - Number of Variable species
+  INTEGER, PARAMETER :: nvar = 32 
+! NVARACT - Number of Active species
+  INTEGER, PARAMETER :: nvaract = 32 
+! NFIX - Number of Fixed species
+  INTEGER, PARAMETER :: nfix = 1 
+! NREACT - Number of reactions
+  INTEGER, PARAMETER :: nreact = 81 
+! NVARST - Starting of variables in conc. vect.
+  INTEGER, PARAMETER :: nvarst = 1 
+! NFIXST - Starting of fixed in conc. vect.
+  INTEGER, PARAMETER :: nfixst = 33 
+! NONZERO - Number of nonzero entries in Jacobian
+  INTEGER, PARAMETER :: nonzero = 276 
+! LU_NONZERO - Number of nonzero entries in LU factoriz. of Jacobian
+  INTEGER, PARAMETER :: lu_nonzero = 300 
+! CNVAR - (NVAR+1) Number of elements in compressed row format
+  INTEGER, PARAMETER :: cnvar = 33 
+! CNEQN - (NREACT+1) Number stoicm elements in compressed col format
+  INTEGER, PARAMETER :: cneqn = 82 
+! NHESS - Length of Sparse Hessian
+  INTEGER, PARAMETER :: nhess = 258 
+! NMASS - Number of atoms to check mass balance
+  INTEGER, PARAMETER :: nmass = 1 
+
+! Index declaration for variable species in C and VAR
+!   VAR(ind_spc) = C(ind_spc)
+
+  INTEGER, PARAMETER, PUBLIC :: ind_o1d_cb4 = 1 
+  INTEGER, PARAMETER, PUBLIC :: ind_h2o2 = 2 
+  INTEGER, PARAMETER, PUBLIC :: ind_pan = 3 
+  INTEGER, PARAMETER, PUBLIC :: ind_cro = 4 
+  INTEGER, PARAMETER, PUBLIC :: ind_tol = 5 
+  INTEGER, PARAMETER, PUBLIC :: ind_n2o5 = 6 
+  INTEGER, PARAMETER, PUBLIC :: ind_xyl = 7 
+  INTEGER, PARAMETER, PUBLIC :: ind_xo2n = 8 
+  INTEGER, PARAMETER, PUBLIC :: ind_hono = 9 
+  INTEGER, PARAMETER, PUBLIC :: ind_pna = 10 
+  INTEGER, PARAMETER, PUBLIC :: ind_to2 = 11 
+  INTEGER, PARAMETER, PUBLIC :: ind_hno3 = 12 
+  INTEGER, PARAMETER, PUBLIC :: ind_ror = 13 
+  INTEGER, PARAMETER, PUBLIC :: ind_cres = 14 
+  INTEGER, PARAMETER, PUBLIC :: ind_mgly = 15 
+  INTEGER, PARAMETER, PUBLIC :: ind_co = 16 
+  INTEGER, PARAMETER, PUBLIC :: ind_eth = 17 
+  INTEGER, PARAMETER, PUBLIC :: ind_xo2 = 18 
+  INTEGER, PARAMETER, PUBLIC :: ind_open = 19 
+  INTEGER, PARAMETER, PUBLIC :: ind_par = 20 
+  INTEGER, PARAMETER, PUBLIC :: ind_hcho = 21 
+  INTEGER, PARAMETER, PUBLIC :: ind_isop = 22 
+  INTEGER, PARAMETER, PUBLIC :: ind_ole = 23 
+  INTEGER, PARAMETER, PUBLIC :: ind_ald2 = 24 
+  INTEGER, PARAMETER, PUBLIC :: ind_o3 = 25 
+  INTEGER, PARAMETER, PUBLIC :: ind_no2 = 26 
+  INTEGER, PARAMETER, PUBLIC :: ind_ho = 27 
+  INTEGER, PARAMETER, PUBLIC :: ind_ho2 = 28 
+  INTEGER, PARAMETER, PUBLIC :: ind_o = 29 
+  INTEGER, PARAMETER, PUBLIC :: ind_no3 = 30 
+  INTEGER, PARAMETER, PUBLIC :: ind_no = 31 
+  INTEGER, PARAMETER, PUBLIC :: ind_c2o3 = 32 
+
+! Index declaration for fixed species in C
+!   C(ind_spc)
+
+  INTEGER, PARAMETER, PUBLIC :: ind_h2o = 33 
+
+! Index declaration for fixed species in FIX
+!    FIX(indf_spc) = C(ind_spc) = C(NVAR+indf_spc)
+
+  INTEGER, PARAMETER :: indf_h2o = 1 
+
+! NJVRP - Length of sparse Jacobian JVRP
+  INTEGER, PARAMETER :: njvrp = 134 
+
+! NSTOICM - Length of Sparse Stoichiometric Matrix
+  INTEGER, PARAMETER :: nstoicm = 329 
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Global Data Module File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Global.f90
+! Time                 : Tue Sep 25 18:35:13 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! Declaration of global variables
+
+! C - Concentration of all species
+  REAL(kind=dp):: c(nspec)
+! VAR - Concentrations of variable species (global)
+  REAL(kind=dp):: var(nvar)
+! FIX - Concentrations of fixed species (global)
+  REAL(kind=dp):: fix(nfix)
+! VAR,FIX are chunks of array C
+      EQUIVALENCE( c(1), var(1))
+      EQUIVALENCE( c(33), fix(1))
+! RCONST - Rate constants (global)
+  REAL(kind=dp):: rconst(nreact)
+! TIME - Current integration time
+  REAL(kind=dp):: time
+! TEMP - Temperature
+  REAL(kind=dp):: temp
+! TSTART - Integration start time
+  REAL(kind=dp):: tstart
+! ATOL - Absolute tolerance
+  REAL(kind=dp):: atol(nvar)
+! RTOL - Relative tolerance
+  REAL(kind=dp):: rtol(nvar)
+! STEPMIN - Lower bound for integration step
+  REAL(kind=dp):: stepmin
+! CFACTOR - Conversion factor for concentration units
+  REAL(kind=dp):: cfactor
+
+! INLINED global variable declarations
+
+! QVAP - Water vapor
+  REAL(kind=dp):: qvap
+! FAKT - Conversion factor
+  REAL(kind=dp):: fakt
+
+  !   declaration of global variable declarations for photolysis will come from 
+
+! QVAP - Water vapor
+  REAL(kind=dp):: qvap
+! FAKT - Conversion factor
+  REAL(kind=dp):: fakt
+
+
+! INLINED global variable declarations
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Sparse Jacobian Data Structures File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_JacobianSP.f90
+! Time                 : Tue Sep 25 18:35:13 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! Sparse Jacobian Data
+
+
+  INTEGER, PARAMETER, DIMENSION(300):: lu_irow =  (/ &
+       1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 4, &
+       4, 5, 5, 6, 6, 6, 7, 7, 8, 8, 8, 8, &
+       8, 8, 8, 8, 8, 9, 9, 9, 9, 10, 10, 10, &
+      10, 11, 11, 11, 11, 11, 12, 12, 12, 12, 12, 12, &
+      12, 12, 13, 13, 13, 13, 14, 14, 14, 14, 14, 14, &
+      14, 15, 15, 15, 15, 15, 15, 16, 16, 16, 16, 16, &
+      16, 16, 16, 16, 16, 16, 16, 17, 17, 17, 17, 17, &
+      18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, &
+      18, 18, 18, 18, 18, 18, 18, 18, 19, 19, 19, 19, &
+      19, 19, 19, 20, 20, 20, 20, 20, 20, 20, 20, 20, &
+      20, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, &
+      21, 21, 22, 22, 22, 22, 22, 23, 23, 23, 23, 23, &
+      23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, &
+      24, 24, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, &
+      25, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, &
+      26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 27, &
+      27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, &
+      27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, &
+      28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, &
+      28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, &
+      29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, &
+      29, 29, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, &
+      30, 30, 30, 30, 30, 31, 31, 31, 31, 31, 31, 31, &
+      31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 31, 32, &
+      32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32 /) 
+
+  INTEGER, PARAMETER, DIMENSION(300):: lu_icol =  (/ &
+       1, 25, 2, 27, 28, 3, 26, 32, 4, 14, 26, 27, &
+      30, 5, 27, 6, 26, 30, 7, 27, 8, 13, 20, 22, &
+      23, 27, 29, 30, 31, 9, 26, 27, 31, 10, 26, 27, &
+      28, 5, 7, 11, 27, 31, 6, 12, 14, 21, 24, 26, &
+      27, 30, 13, 20, 26, 27, 5, 7, 11, 14, 27, 30, &
+      31, 7, 15, 19, 22, 25, 27, 15, 16, 17, 19, 21, &
+      22, 23, 24, 25, 27, 29, 30, 17, 22, 25, 27, 29, &
+       5, 7, 13, 14, 15, 17, 18, 19, 20, 22, 23, 24, &
+      25, 26, 27, 28, 29, 30, 31, 32, 11, 14, 19, 25, &
+      27, 30, 31, 7, 13, 20, 22, 23, 25, 26, 27, 29, &
+      30, 17, 19, 21, 22, 23, 24, 25, 27, 28, 29, 30, &
+      31, 32, 22, 25, 27, 29, 30, 22, 23, 25, 27, 29, &
+      30, 13, 17, 19, 20, 22, 23, 24, 25, 26, 27, 29, &
+      30, 31, 17, 19, 22, 23, 25, 26, 27, 28, 29, 30, &
+      31, 3, 4, 6, 9, 10, 11, 13, 14, 18, 19, 20, &
+      22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 1, &
+       2, 5, 7, 9, 10, 12, 14, 15, 16, 17, 19, 20, &
+      21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, &
+       2, 5, 7, 10, 11, 13, 14, 15, 16, 17, 19, 20, &
+      21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, &
+       1, 17, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, &
+      31, 32, 6, 12, 14, 21, 22, 23, 24, 25, 26, 27, &
+      28, 29, 30, 31, 32, 8, 9, 11, 13, 18, 19, 20, &
+      22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 3, &
+      15, 19, 22, 24, 25, 26, 27, 28, 29, 30, 31, 32 /) 
+
+  INTEGER, PARAMETER, DIMENSION(33):: lu_crow =  (/ &
+       1, 3, 6, 9, 14, 16, 19, 21, 30, 34, 38, 43, &
+      51, 55, 62, 68, 80, 85, 105, 112, 122, 135, 140, 146, &
+     159, 170, 192, 217, 241, 255, 270, 288, 301 /) 
+
+  INTEGER, PARAMETER, DIMENSION(33):: lu_diag =  (/ &
+       1, 3, 6, 9, 14, 16, 19, 21, 30, 34, 40, 44, &
+      51, 58, 63, 69, 80, 91, 107, 114, 124, 135, 141, 152, &
+     163, 185, 211, 236, 251, 267, 286, 300, 301 /) 
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Utility Data Module File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Monitor.f90
+! Time                 : Tue Sep 25 18:35:13 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+  CHARACTER(len=15), PARAMETER, DIMENSION(33):: spc_names =  (/ &
+     'O1D_CB4        ','H2O2           ','PAN            ',&
+     'CRO            ','TOL            ','N2O5           ',&
+     'XYL            ','XO2N           ','HONO           ',&
+     'PNA            ','TO2            ','HNO3           ',&
+     'ROR            ','CRES           ','MGLY           ',&
+     'CO             ','ETH            ','XO2            ',&
+     'OPEN           ','PAR            ','HCHO           ',&
+     'ISOP           ','OLE            ','ALD2           ',&
+     'O3             ','NO2            ','HO             ',&
+     'HO2            ','O              ','NO3            ',&
+     'NO             ','C2O3           ','H2O            ' /)
+
+  CHARACTER(len=100), PARAMETER, DIMENSION(30):: eqn_names_0 =  (/ &
+     '           NO2 --> O + NO                                                                           ',&
+     '            O3 --> O                                                                                ',&
+     '            O3 --> O1D_CB4                                                                          ',&
+     '           NO3 --> 0.89 NO2 + 0.89 O + 0.11 NO                                                      ',&
+     '          HONO --> HO + NO                                                                          ',&
+     '          H2O2 --> 2 HO                                                                             ',&
+     '          HCHO --> CO + 2 HO2                                                                       ',&
+     '          HCHO --> CO                                                                               ',&
+     '          ALD2 --> CO + XO2 + HCHO + 2 HO2                                                          ',&
+     '          OPEN --> CO + HO2 + C2O3                                                                  ',&
+     '          MGLY --> CO + HO2 + C2O3                                                                  ',&
+     '             O --> O3                                                                               ',&
+     '       O3 + NO --> NO2                                                                              ',&
+     '       NO2 + O --> NO                                                                               ',&
+     '       NO2 + O --> NO3                                                                              ',&
+     '        O + NO --> NO2                                                                              ',&
+     '      O3 + NO2 --> NO3                                                                              ',&
+     '       O1D_CB4 --> O                                                                                ',&
+     ' O1D_CB4 + H2O --> 2 HO                                                                             ',&
+     '       O3 + HO --> HO2                                                                              ',&
+     '      O3 + HO2 --> HO                                                                               ',&
+     '      NO3 + NO --> 2 NO2                                                                            ',&
+     '     NO2 + NO3 --> NO2 + NO                                                                         ',&
+     '     NO2 + NO3 --> N2O5                                                                             ',&
+     '    N2O5 + H2O --> 2 HNO3                                                                           ',&
+     '          N2O5 --> NO2 + NO3                                                                        ',&
+     '          2 NO --> 2 NO2                                                                            ',&
+     'NO2 + NO + H2O --> 2 HONO                                                                           ',&
+     '       HO + NO --> HONO                                                                             ',&
+     '     HONO + HO --> NO2                                                                              ' /)
+  CHARACTER(len=100), PARAMETER, DIMENSION(30):: eqn_names_1 =  (/ &
+     '        2 HONO --> NO2 + NO                                                                         ',&
+     '      NO2 + HO --> HNO3                                                                             ',&
+     '     HNO3 + HO --> NO3                                                                              ',&
+     '      HO2 + NO --> NO2 + HO                                                                         ',&
+     '     NO2 + HO2 --> PNA                                                                              ',&
+     '           PNA --> NO2 + HO2                                                                        ',&
+     '      PNA + HO --> NO2                                                                              ',&
+     '         2 HO2 --> H2O2                                                                             ',&
+     '   2 HO2 + H2O --> H2O2                                                                             ',&
+     '     H2O2 + HO --> HO2                                                                              ',&
+     '       CO + HO --> HO2                                                                              ',&
+     '     HCHO + HO --> CO + HO2                                                                         ',&
+     '      HCHO + O --> CO + HO + HO2                                                                    ',&
+     '    HCHO + NO3 --> HNO3 + CO + HO2                                                                  ',&
+     '      ALD2 + O --> HO + C2O3                                                                        ',&
+     '     ALD2 + HO --> C2O3                                                                             ',&
+     '    ALD2 + NO3 --> HNO3 + C2O3                                                                      ',&
+     '     NO + C2O3 --> XO2 + HCHO + NO2 + HO2                                                           ',&
+     '    NO2 + C2O3 --> PAN                                                                              ',&
+     '           PAN --> NO2 + C2O3                                                                       ',&
+     '        2 C2O3 --> 2 XO2 + 2 HCHO + 2 HO2                                                           ',&
+     '    HO2 + C2O3 --> 0.79 XO2 + 0.79 HCHO + 0.79 HO + 0.79 HO2                                        ',&
+     '            HO --> XO2 + HCHO + HO2                                                                 ',&
+     '      PAR + HO --> 0.13 XO2N + 0.76 ROR + 0.87 XO2 - -0.11 PAR + 0.11 ALD2 ... etc.                 ',&
+     '           ROR --> 0.04 XO2N + 0.02 ROR + 0.96 XO2 - -2.1 PAR + 1.1 ALD2 ... etc.                   ',&
+     '           ROR --> HO2                                                                              ',&
+     '     ROR + NO2 -->                                                                                  ',&
+     '       OLE + O --> 0.02 XO2N + 0.3 CO + 0.28 XO2 + 0.22 PAR + 0.2 HCHO ... etc.                     ',&
+     '      OLE + HO --> XO2 - PAR + HCHO + ALD2 + HO2                                                    ',&
+     '      OLE + O3 --> 0.33 CO + 0.22 XO2 - PAR + 0.74 HCHO + 0.5 ALD2 + 0.1 HO ... etc.                ' /)
+  CHARACTER(len=100), PARAMETER, DIMENSION(21):: eqn_names_2 =  (/ &
+     '     OLE + NO3 --> 0.09 XO2N + 0.91 XO2 - PAR + HCHO + ALD2 + NO2                                   ',&
+     '       ETH + O --> CO + 0.7 XO2 + HCHO + 0.3 HO + 1.7 HO2                                           ',&
+     '      ETH + HO --> XO2 + 1.56 HCHO + 0.22 ALD2 + HO2                                                ',&
+     '      ETH + O3 --> 0.42 CO + HCHO + 0.12 HO2                                                        ',&
+     '      TOL + HO --> 0.56 TO2 + 0.36 CRES + 0.08 XO2 + 0.44 HO2                                       ',&
+     '      TO2 + NO --> 0.9 OPEN + 0.9 NO2 + 0.9 HO2                                                     ',&
+     '           TO2 --> CRES + HO2                                                                       ',&
+     '     CRES + HO --> 0.4 CRO + 0.6 XO2 + 0.3 OPEN + 0.6 HO2                                           ',&
+     '    CRES + NO3 --> CRO + HNO3                                                                       ',&
+     '     CRO + NO2 -->                                                                                  ',&
+     '      XYL + HO --> 0.3 TO2 + 0.2 CRES + 0.8 MGLY + 0.5 XO2 + 1.1 PAR + 0.7 HO2 ... etc.             ',&
+     '     OPEN + HO --> 2 CO + XO2 + HCHO + 2 HO2 + C2O3                                                 ',&
+     '     OPEN + O3 --> 0.2 MGLY + 0.69 CO + 0.03 XO2 + 0.7 HCHO + 0.03 ALD2 ... etc.                    ',&
+     '     MGLY + HO --> XO2 + C2O3                                                                       ',&
+     '      ISOP + O --> 0.5 CO + 0.45 ETH + 0.5 XO2 + 0.9 PAR + 0.55 OLE + 0.8 ALD2 ... etc.             ',&
+     '     ISOP + HO --> 0.13 XO2N + 0.4 MGLY + ETH + XO2 + HCHO + 0.2 ALD2 + 0.67 HO2 ... etc.           ',&
+     '     ISOP + O3 --> 0.2 MGLY + 0.06 CO + 0.55 ETH + 0.1 PAR + HCHO + 0.4 ALD2 ... etc.               ',&
+     '    ISOP + NO3 --> XO2N                                                                             ',&
+     '      XO2 + NO --> NO2                                                                              ',&
+     '         2 XO2 -->                                                                                  ',&
+     '     XO2N + NO -->                                                                                  ' /)
+  CHARACTER(len=100), PARAMETER, DIMENSION(81):: eqn_names =  (/&
+    eqn_names_0, eqn_names_1, eqn_names_2 /) 
+
+! INLINED global variables
+
+  !   inline f90_data: declaration of global variables for photolysis
+  !   REAL(kind=dp):: phot(nphot)must eventually be moved to global later for 
+  INTEGER, PARAMETER :: nphot = 9
+  !   phot photolysis frequencies 
+  REAL(kind=dp):: phot(nphot)
+
+  INTEGER, PARAMETER, PUBLIC :: j_no2 = 1
+  INTEGER, PARAMETER, PUBLIC :: j_o33p = 2
+  INTEGER, PARAMETER, PUBLIC :: j_o31d = 3
+  INTEGER, PARAMETER, PUBLIC :: j_no3o = 4
+  INTEGER, PARAMETER, PUBLIC :: j_no3o2 = 5
+  INTEGER, PARAMETER, PUBLIC :: j_hono = 6
+  INTEGER, PARAMETER, PUBLIC :: j_h2o2 = 7
+  INTEGER, PARAMETER, PUBLIC :: j_ch2or = 8
+  INTEGER, PARAMETER, PUBLIC :: j_ch2om = 9
+
+  CHARACTER(len=15), PARAMETER, DIMENSION(nphot):: phot_names =   (/ &
+     'J_NO2          ','J_O33P         ','J_O31D         ',         &
+     'J_NO3O         ','J_NO3O2        ','J_HONO         ',         &
+     'J_H2O2         ','J_HCHO_B       ','J_HCHO_A       '/)
+
+! End INLINED global variables
+
+
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+ 
+!  variable definations from  individual module headers 
+ 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Initialization File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Initialize.f90
+! Time                 : Tue Sep 25 18:35:13 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Numerical Integrator (Time-Stepping) File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Integrator.f90
+! Time                 : Tue Sep 25 18:35:13 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! INTEGRATE - Integrator routine
+!   Arguments :
+!      TIN       - Start Time for Integration
+!      TOUT      - End Time for Integration
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
+!  Rosenbrock - Implementation of several Rosenbrock methods:             !
+!               *Ros2                                                    !
+!               *Ros3                                                    !
+!               *Ros4                                                    !
+!               *Rodas3                                                  !
+!               *Rodas4                                                  !
+!  By default the code employs the KPP sparse linear algebra routines     !
+!  Compile with -DFULL_ALGEBRA to use full linear algebra (LAPACK)        !
+!                                                                         !
+!    (C)  Adrian Sandu,August 2004                                       !
+!    Virginia Polytechnic Institute and State University                  !
+!    Contact: sandu@cs.vt.edu                                             !
+!    Revised by Philipp Miehe and Adrian Sandu,May 2006                  !                               !
+!    This implementation is part of KPP - the Kinetic PreProcessor        !
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
+
+
+  SAVE
+  
+!~~~>  statistics on the work performed by the rosenbrock method
+  INTEGER, PARAMETER :: nfun=1, njac=2, nstp=3, nacc=4, &
+                        nrej=5, ndec=6, nsol=7, nsng=8, &
+                        ntexit=1, nhexit=2, nhnew = 3
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Linear Algebra Data and Routines File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_LinearAlgebra.f90
+! Time                 : Tue Sep 25 18:35:13 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! The ODE Jacobian of Chemical Model File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Jacobian.f90
+! Time                 : Tue Sep 25 18:35:13 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! The ODE Function of Chemical Model File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Function.f90
+! Time                 : Tue Sep 25 18:35:13 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+! A - Rate for each equation
+  REAL(kind=dp):: a(nreact)
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! The Reaction Rates File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Rates.f90
+! Time                 : Tue Sep 25 18:35:13 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Auxiliary Routines File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Util.f90
+! Time                 : Tue Sep 25 18:35:13 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+  ! header MODULE initialize_kpp_ctrl_template
+
+  ! notes:
+  ! - l_vector is automatically defined by kp4
+  ! - vl_dim is automatically defined by kp4
+  ! - i_lu_di is automatically defined by kp4
+  ! - wanted is automatically defined by xmecca
+  ! - icntrl rcntrl are automatically defined by kpp
+  ! - "USE messy_main_tools" is in MODULE_header of messy_mecca_kpp.f90
+  ! - SAVE will be automatically added by kp4
+
+  !SAVE
+
+  ! for fixed time step control
+  ! ... max. number of fixed time steps (sum must be 1)
+  INTEGER, PARAMETER         :: nmaxfixsteps = 50
+  ! ... switch for fixed time stepping
+  LOGICAL, PUBLIC            :: l_fixed_step = .FALSE.
+  INTEGER, PUBLIC            :: nfsteps = 1
+  ! ... number of kpp control PARAMETERs
+  INTEGER, PARAMETER, PUBLIC :: nkppctrl = 20
+  !
+  INTEGER, DIMENSION(nkppctrl), PUBLIC     :: icntrl = 0
+  REAL(dp), DIMENSION(nkppctrl), PUBLIC     :: rcntrl = 0.0_dp
+  REAL(dp), DIMENSION(nmaxfixsteps), PUBLIC :: t_steps = 0.0_dp
+
+  ! END header MODULE initialize_kpp_ctrl_template
+
+ 
+! Interface Block 
+ 
+  INTERFACE            initialize
+    MODULE PROCEDURE   initialize
+  END INTERFACE        initialize
+ 
+  INTERFACE            integrate
+    MODULE PROCEDURE   integrate
+  END INTERFACE        integrate
+ 
+  INTERFACE            fun
+    MODULE PROCEDURE   fun
+  END INTERFACE        fun
+ 
+  INTERFACE            kppsolve
+    MODULE PROCEDURE   kppsolve
+  END INTERFACE        kppsolve
+ 
+  INTERFACE            jac_sp
+    MODULE PROCEDURE   jac_sp
+  END INTERFACE        jac_sp
+ 
+  INTERFACE            k_arr
+    MODULE PROCEDURE   k_arr
+  END INTERFACE        k_arr
+ 
+  INTERFACE            update_rconst
+    MODULE PROCEDURE   update_rconst
+  END INTERFACE        update_rconst
+ 
+  INTERFACE            arr2
+    MODULE PROCEDURE   arr2
+  END INTERFACE        arr2
+ 
+  INTERFACE            initialize_kpp_ctrl
+    MODULE PROCEDURE   initialize_kpp_ctrl
+  END INTERFACE        initialize_kpp_ctrl
+ 
+  INTERFACE            error_output
+    MODULE PROCEDURE   error_output
+  END INTERFACE        error_output
+ 
+  INTERFACE            wscal
+    MODULE PROCEDURE   wscal
+  END INTERFACE        wscal
+ 
+!INTERFACE not working  INTERFACE            waxpy
+!INTERFACE not working    MODULE PROCEDURE   waxpy
+!INTERFACE not working  END INTERFACE        waxpy
+ 
+  INTERFACE            rosenbrock
+    MODULE PROCEDURE   rosenbrock
+  END INTERFACE        rosenbrock
+ 
+  INTERFACE            funtemplate
+    MODULE PROCEDURE   funtemplate
+  END INTERFACE        funtemplate
+ 
+  INTERFACE            jactemplate
+    MODULE PROCEDURE   jactemplate
+  END INTERFACE        jactemplate
+ 
+  INTERFACE            kppdecomp
+    MODULE PROCEDURE   kppdecomp
+  END INTERFACE        kppdecomp
+ 
+  INTERFACE            chem_gasphase_integrate
+    MODULE PROCEDURE   chem_gasphase_integrate
+  END INTERFACE        chem_gasphase_integrate
+ 
+ 
+ CONTAINS
+ 
+SUBROUTINE initialize()
+
+
+  INTEGER         :: j, k
+
+  INTEGER :: i
+  REAL(kind=dp):: x
+  k = is
+  cfactor = 1.000000e+00_dp
+
+  x = (0.) * cfactor
+  DO i = 1 , nvar
+  ENDDO
+
+  x = (0.) * cfactor
+  DO i = 1 , nfix
+    fix(i) = x
+  ENDDO
+
+! constant rate coefficients
+! END constant rate coefficients
+
+! INLINED initializations
+
+  fix(indf_h2o) = qvap 
+
+! End INLINED initializations
+
+      
+END SUBROUTINE initialize
+ 
+SUBROUTINE integrate( tin, tout, &
+  icntrl_u, rcntrl_u, istatus_u, rstatus_u, ierr_u)
+
+
+   REAL(kind=dp), INTENT(IN):: tin  ! start time
+   REAL(kind=dp), INTENT(IN):: tout ! END time
+   ! OPTIONAL input PARAMETERs and statistics
+   INTEGER,      INTENT(IN), OPTIONAL :: icntrl_u(20)
+   REAL(kind=dp), INTENT(IN), OPTIONAL :: rcntrl_u(20)
+   INTEGER,      INTENT(OUT), OPTIONAL :: istatus_u(20)
+   REAL(kind=dp), INTENT(OUT), OPTIONAL :: rstatus_u(20)
+   INTEGER,      INTENT(OUT), OPTIONAL :: ierr_u
+
+   REAL(kind=dp):: rcntrl(20), rstatus(20)
+   INTEGER       :: icntrl(20), istatus(20), ierr
+
+   INTEGER, SAVE :: ntotal = 0
+
+   icntrl(:) = 0
+   rcntrl(:) = 0.0_dp
+   istatus(:) = 0
+   rstatus(:) = 0.0_dp
+
+    !~~~> fine-tune the integrator:
+   icntrl(1) = 0      ! 0 - non- autonomous, 1 - autonomous
+   icntrl(2) = 0      ! 0 - vector tolerances, 1 - scalars
+
+   ! IF OPTIONAL PARAMETERs are given, and IF they are >0, 
+   ! THEN they overwrite default settings. 
+   IF (PRESENT(icntrl_u))THEN
+     WHERE(icntrl_u(:)> 0)icntrl(:) = icntrl_u(:)
+   ENDIF
+   IF (PRESENT(rcntrl_u))THEN
+     WHERE(rcntrl_u(:)> 0)rcntrl(:) = rcntrl_u(:)
+   ENDIF
+
+
+   CALL rosenbrock(nvar, var, tin, tout,  &
+         atol, rtol,               &
+         rcntrl, icntrl, rstatus, istatus, ierr)
+
+   !~~~> debug option: show no of steps
+   ! ntotal = ntotal + istatus(nstp)
+   ! PRINT*,'NSTEPS=',ISTATUS(Nstp),' (',Ntotal,')','  O3=',VAR(ind_O3)
+
+   stepmin = rstatus(nhexit)
+   ! IF OPTIONAL PARAMETERs are given for output they 
+   ! are updated with the RETURN information
+   IF (PRESENT(istatus_u))istatus_u(:) = istatus(:)
+   IF (PRESENT(rstatus_u))rstatus_u(:) = rstatus(:)
+   IF (PRESENT(ierr_u))  ierr_u       = ierr
+
+END SUBROUTINE integrate
+ 
+SUBROUTINE fun(v, f, rct, vdot)
+
+! V - Concentrations of variable species (local)
+  REAL(kind=dp):: v(nvar)
+! F - Concentrations of fixed species (local)
+  REAL(kind=dp):: f(nfix)
+! RCT - Rate constants (local)
+  REAL(kind=dp):: rct(nreact)
+! Vdot - Time derivative of variable species concentrations
+  REAL(kind=dp):: vdot(nvar)
+
+
+! Computation of equation rates
+  a(1) = rct(1) * v(26)
+  a(2) = rct(2) * v(25)
+  a(3) = rct(3) * v(25)
+  a(4) = rct(4) * v(30)
+  a(5) = rct(5) * v(9)
+  a(6) = rct(6) * v(2)
+  a(7) = rct(7) * v(21)
+  a(8) = rct(8) * v(21)
+  a(9) = rct(9) * v(24)
+  a(10) = rct(10) * v(19)
+  a(11) = rct(11) * v(15)
+  a(12) = rct(12) * v(29)
+  a(13) = rct(13) * v(25) * v(31)
+  a(14) = rct(14) * v(26) * v(29)
+  a(15) = rct(15) * v(26) * v(29)
+  a(16) = rct(16) * v(29) * v(31)
+  a(17) = rct(17) * v(25) * v(26)
+  a(18) = rct(18) * v(1)
+  a(19) = rct(19) * v(1) * f(1)
+  a(20) = rct(20) * v(25) * v(27)
+  a(21) = rct(21) * v(25) * v(28)
+  a(22) = rct(22) * v(30) * v(31)
+  a(23) = rct(23) * v(26) * v(30)
+  a(24) = rct(24) * v(26) * v(30)
+  a(25) = rct(25) * v(6) * f(1)
+  a(26) = rct(26) * v(6)
+  a(27) = rct(27) * v(31) * v(31)
+  a(28) = rct(28) * v(26) * v(31) * f(1)
+  a(29) = rct(29) * v(27) * v(31)
+  a(30) = rct(30) * v(9) * v(27)
+  a(31) = rct(31) * v(9) * v(9)
+  a(32) = rct(32) * v(26) * v(27)
+  a(33) = rct(33) * v(12) * v(27)
+  a(34) = rct(34) * v(28) * v(31)
+  a(35) = rct(35) * v(26) * v(28)
+  a(36) = rct(36) * v(10)
+  a(37) = rct(37) * v(10) * v(27)
+  a(38) = rct(38) * v(28) * v(28)
+  a(39) = rct(39) * v(28) * v(28) * f(1)
+  a(40) = rct(40) * v(2) * v(27)
+  a(41) = rct(41) * v(16) * v(27)
+  a(42) = rct(42) * v(21) * v(27)
+  a(43) = rct(43) * v(21) * v(29)
+  a(44) = rct(44) * v(21) * v(30)
+  a(45) = rct(45) * v(24) * v(29)
+  a(46) = rct(46) * v(24) * v(27)
+  a(47) = rct(47) * v(24) * v(30)
+  a(48) = rct(48) * v(31) * v(32)
+  a(49) = rct(49) * v(26) * v(32)
+  a(50) = rct(50) * v(3)
+  a(51) = rct(51) * v(32) * v(32)
+  a(52) = rct(52) * v(28) * v(32)
+  a(53) = rct(53) * v(27)
+  a(54) = rct(54) * v(20) * v(27)
+  a(55) = rct(55) * v(13)
+  a(56) = rct(56) * v(13)
+  a(57) = rct(57) * v(13) * v(26)
+  a(58) = rct(58) * v(23) * v(29)
+  a(59) = rct(59) * v(23) * v(27)
+  a(60) = rct(60) * v(23) * v(25)
+  a(61) = rct(61) * v(23) * v(30)
+  a(62) = rct(62) * v(17) * v(29)
+  a(63) = rct(63) * v(17) * v(27)
+  a(64) = rct(64) * v(17) * v(25)
+  a(65) = rct(65) * v(5) * v(27)
+  a(66) = rct(66) * v(11) * v(31)
+  a(67) = rct(67) * v(11)
+  a(68) = rct(68) * v(14) * v(27)
+  a(69) = rct(69) * v(14) * v(30)
+  a(70) = rct(70) * v(4) * v(26)
+  a(71) = rct(71) * v(7) * v(27)
+  a(72) = rct(72) * v(19) * v(27)
+  a(73) = rct(73) * v(19) * v(25)
+  a(74) = rct(74) * v(15) * v(27)
+  a(75) = rct(75) * v(22) * v(29)
+  a(76) = rct(76) * v(22) * v(27)
+  a(77) = rct(77) * v(22) * v(25)
+  a(78) = rct(78) * v(22) * v(30)
+  a(79) = rct(79) * v(18) * v(31)
+  a(80) = rct(80) * v(18) * v(18)
+  a(81) = rct(81) * v(8) * v(31)
+
+! Aggregate function
+  vdot(1) = a(3) - a(18) - a(19)
+  vdot(2) = - a(6) + a(38) + a(39) - a(40)
+  vdot(3) = a(49) - a(50)
+  vdot(4) = 0.4* a(68) + a(69) - a(70)
+  vdot(5) = - a(65)
+  vdot(6) = a(24) - a(25) - a(26)
+  vdot(7) = - a(71)
+  vdot(8) = 0.13* a(54) + 0.04* a(55) + 0.02* a(58) + 0.09* a(61) + 0.13* a(76) + a(78) - a(81)
+  vdot(9) = - a(5) + 2* a(28) + a(29) - a(30) - 2* a(31)
+  vdot(10) = a(35) - a(36) - a(37)
+  vdot(11) = 0.56* a(65) - a(66) - a(67) + 0.3* a(71)
+  vdot(12) = 2* a(25) + a(32) - a(33) + a(44) + a(47) + a(69)
+  vdot(13) = 0.76* a(54) - 0.98* a(55) - a(56) - a(57)
+  vdot(14) = 0.36* a(65) + a(67) - a(68) - a(69) + 0.2* a(71)
+  vdot(15) = - a(11) + 0.8* a(71) + 0.2* a(73) - a(74) + 0.4* a(76) + 0.2* a(77)
+  vdot(16) = a(7) + a(8) + a(9) + a(10) + a(11) - a(41) + a(42) + a(43) + a(44) + 0.3* a(58) + 0.33* a(60) + a(62) + 0.42* a(64) &
+                     + 2* a(72) + 0.69* a(73)&
+               &+ 0.5* a(75) + 0.06* a(77)
+  vdot(17) = - a(62) - a(63) - a(64) + 0.45* a(75) + a(76) + 0.55* a(77)
+  vdot(18) = a(9) + a(48) + 2* a(51) + 0.79* a(52) + a(53) + 0.87* a(54) + 0.96* a(55) + 0.28* a(58) + a(59) + 0.22* a(60) + &
+                     0.91* a(61) + 0.7* a(62)&
+               &+ a(63) + 0.08* a(65) + 0.6* a(68) + 0.5* a(71) + a(72) + 0.03* a(73) + a(74) + 0.5* a(75) + a(76) - a(79) - 2* &
+                     a(80)
+  vdot(19) = - a(10) + 0.9* a(66) + 0.3* a(68) - a(72) - a(73)
+  vdot(20) = - 1.11* a(54) - 2.1* a(55) + 0.22* a(58) - a(59) - a(60) - a(61) + 1.1* a(71) + 0.9* a(75) + 0.1* a(77)
+  vdot(21) = - a(7) - a(8) + a(9) - a(42) - a(43) - a(44) + a(48) + 2* a(51) + 0.79* a(52) + a(53) + 0.2* a(58) + a(59) + 0.74* &
+                     a(60) + a(61) + a(62)&
+               &+ 1.56* a(63) + a(64) + a(72) + 0.7* a(73) + a(76) + a(77)
+  vdot(22) = - a(75) - a(76) - a(77) - a(78)
+  vdot(23) = - a(58) - a(59) - a(60) - a(61) + 0.55* a(75)
+  vdot(24) = - a(9) - a(45) - a(46) - a(47) + 0.11* a(54) + 1.1* a(55) + 0.63* a(58) + a(59) + 0.5* a(60) + a(61) + 0.22* a(63) + &
+                     0.03* a(73) + 0.8&
+               &* a(75) + 0.2* a(76) + 0.4* a(77)
+  vdot(25) = - a(2) - a(3) + a(12) - a(13) - a(17) - a(20) - a(21) - a(60) - a(64) - a(73) - a(77)
+  vdot(26) = - a(1) + 0.89* a(4) + a(13) - a(14) - a(15) + a(16) - a(17) + 2* a(22) - a(24) + a(26) + 2* a(27) - a(28) + a(30) + &
+                     a(31) - a(32) + a(34)&
+               &- a(35) + a(36) + a(37) + a(48) - a(49) + a(50) - a(57) + a(61) + 0.9* a(66) - a(70) + a(79)
+  vdot(27) = a(5) + 2* a(6) + 2* a(19) - a(20) + a(21) - a(29) - a(30) - a(32) - a(33) + a(34) - a(37) - a(40) - a(41) - a(42) + &
+                     a(43) + a(45) - a(46)&
+               &+ 0.79* a(52) - a(53) - a(54) + 0.2* a(58) - a(59) + 0.1* a(60) + 0.3* a(62) - a(63) - a(65) - a(68) - a(71) - &
+                     a(72) + 0.08* a(73) - a(74)&
+               &- a(76) + 0.1* a(77)
+  vdot(28) = 2* a(7) + 2* a(9) + a(10) + a(11) + a(20) - a(21) - a(34) - a(35) + a(36) - 2* a(38) - 2* a(39) + a(40) + a(41) + &
+                     a(42) + a(43) + a(44) + a(48)&
+               &+ 2* a(51) - 0.21* a(52) + a(53) + 0.11* a(54) + 0.94* a(55) + a(56) + 0.38* a(58) + a(59) + 0.44* a(60) + 1.7* &
+                     a(62) + a(63) + 0.12* a(64)&
+               &+ 0.44* a(65) + 0.9* a(66) + a(67) + 0.6* a(68) + 0.7* a(71) + 2* a(72) + 0.76* a(73) + 0.6* a(75) + 0.67* a(76) &
+                     + 0.44* a(77)
+  vdot(29) = a(1) + a(2) + 0.89* a(4) - a(12) - a(14) - a(15) - a(16) + a(18) - a(43) - a(45) - a(58) - a(62) - a(75)
+  vdot(30) = - a(4) + a(15) + a(17) - a(22) - a(23) - a(24) + a(26) + a(33) - a(44) - a(47) - a(61) - a(69) - a(78)
+  vdot(31) = a(1) + 0.11* a(4) + a(5) - a(13) + a(14) - a(16) - a(22) + a(23) - 2* a(27) - a(28) - a(29) + a(31) - a(34) - a(48) &
+                     - a(66) - a(79) - a(81)
+  vdot(32) = a(10) + a(11) + a(45) + a(46) + a(47) - a(48) - a(49) + a(50) - 2* a(51) - a(52) + a(72) + 0.62* a(73) + a(74) + &
+                     0.2* a(76)
+      
+END SUBROUTINE fun
+ 
+SUBROUTINE kppsolve(jvs, x)
+
+! JVS - sparse Jacobian of variables
+  REAL(kind=dp):: jvs(lu_nonzero)
+! X - Vector for variables
+  REAL(kind=dp):: x(nvar)
+
+  x(11) = x(11) - jvs(38) * x(5) - jvs(39) * x(7)
+  x(12) = x(12) - jvs(43) * x(6)
+  x(14) = x(14) - jvs(55) * x(5) - jvs(56) * x(7) - jvs(57) * x(11)
+  x(15) = x(15) - jvs(62) * x(7)
+  x(16) = x(16) - jvs(68) * x(15)
+  x(18) = x(18) - jvs(85) * x(5) - jvs(86) * x(7) - jvs(87) * x(13) - jvs(88) * x(14) - jvs(89) * x(15) - jvs(90) * x(17)
+  x(19) = x(19) - jvs(105) * x(11) - jvs(106) * x(14)
+  x(20) = x(20) - jvs(112) * x(7) - jvs(113) * x(13)
+  x(21) = x(21) - jvs(122) * x(17) - jvs(123) * x(19)
+  x(23) = x(23) - jvs(140) * x(22)
+  x(24) = x(24) - jvs(146) * x(13) - jvs(147) * x(17) - jvs(148) * x(19) - jvs(149) * x(20) - jvs(150) * x(22) - jvs(151) * x(23)
+  x(25) = x(25) - jvs(159) * x(17) - jvs(160) * x(19) - jvs(161) * x(22) - jvs(162) * x(23)
+  x(26) = x(26) - jvs(170) * x(3) - jvs(171) * x(4) - jvs(172) * x(6) - jvs(173) * x(9) - jvs(174) * x(10) - jvs(175) * x(11) - &
+                     jvs(176) * x(13)&
+            &- jvs(177) * x(14) - jvs(178) * x(18) - jvs(179) * x(19) - jvs(180) * x(20) - jvs(181) * x(22) - jvs(182) * x(23) - &
+                     jvs(183) * x(24)&
+            &- jvs(184) * x(25)
+  x(27) = x(27) - jvs(192) * x(1) - jvs(193) * x(2) - jvs(194) * x(5) - jvs(195) * x(7) - jvs(196) * x(9) - jvs(197) * x(10) - &
+                     jvs(198) * x(12)&
+            &- jvs(199) * x(14) - jvs(200) * x(15) - jvs(201) * x(16) - jvs(202) * x(17) - jvs(203) * x(19) - jvs(204) * x(20) - &
+                     jvs(205) * x(21)&
+            &- jvs(206) * x(22) - jvs(207) * x(23) - jvs(208) * x(24) - jvs(209) * x(25) - jvs(210) * x(26)
+  x(28) = x(28) - jvs(217) * x(2) - jvs(218) * x(5) - jvs(219) * x(7) - jvs(220) * x(10) - jvs(221) * x(11) - jvs(222) * x(13) - &
+                     jvs(223) * x(14)&
+            &- jvs(224) * x(15) - jvs(225) * x(16) - jvs(226) * x(17) - jvs(227) * x(19) - jvs(228) * x(20) - jvs(229) * x(21) - &
+                     jvs(230) * x(22)&
+            &- jvs(231) * x(23) - jvs(232) * x(24) - jvs(233) * x(25) - jvs(234) * x(26) - jvs(235) * x(27)
+  x(29) = x(29) - jvs(241) * x(1) - jvs(242) * x(17) - jvs(243) * x(21) - jvs(244) * x(22) - jvs(245) * x(23) - jvs(246) * x(24) &
+                     - jvs(247) * x(25)&
+            &- jvs(248) * x(26) - jvs(249) * x(27) - jvs(250) * x(28)
+  x(30) = x(30) - jvs(255) * x(6) - jvs(256) * x(12) - jvs(257) * x(14) - jvs(258) * x(21) - jvs(259) * x(22) - jvs(260) * x(23) &
+                     - jvs(261) * x(24)&
+            &- jvs(262) * x(25) - jvs(263) * x(26) - jvs(264) * x(27) - jvs(265) * x(28) - jvs(266) * x(29)
+  x(31) = x(31) - jvs(270) * x(8) - jvs(271) * x(9) - jvs(272) * x(11) - jvs(273) * x(13) - jvs(274) * x(18) - jvs(275) * x(19) - &
+                     jvs(276) * x(20)&
+            &- jvs(277) * x(22) - jvs(278) * x(23) - jvs(279) * x(24) - jvs(280) * x(25) - jvs(281) * x(26) - jvs(282) * x(27) - &
+                     jvs(283) * x(28)&
+            &- jvs(284) * x(29) - jvs(285) * x(30)
+  x(32) = x(32) - jvs(288) * x(3) - jvs(289) * x(15) - jvs(290) * x(19) - jvs(291) * x(22) - jvs(292) * x(24) - jvs(293) * x(25) &
+                     - jvs(294) * x(26)&
+            &- jvs(295) * x(27) - jvs(296) * x(28) - jvs(297) * x(29) - jvs(298) * x(30) - jvs(299) * x(31)
+  x(32) = x(32) / jvs(300)
+  x(31) = (x(31) - jvs(287) * x(32)) /(jvs(286))
+  x(30) = (x(30) - jvs(268) * x(31) - jvs(269) * x(32)) /(jvs(267))
+  x(29) = (x(29) - jvs(252) * x(30) - jvs(253) * x(31) - jvs(254) * x(32)) /(jvs(251))
+  x(28) = (x(28) - jvs(237) * x(29) - jvs(238) * x(30) - jvs(239) * x(31) - jvs(240) * x(32)) /(jvs(236))
+  x(27) = (x(27) - jvs(212) * x(28) - jvs(213) * x(29) - jvs(214) * x(30) - jvs(215) * x(31) - jvs(216) * x(32)) /(jvs(211))
+  x(26) = (x(26) - jvs(186) * x(27) - jvs(187) * x(28) - jvs(188) * x(29) - jvs(189) * x(30) - jvs(190) * x(31) - jvs(191) * &
+                     x(32)) /(jvs(185))
+  x(25) = (x(25) - jvs(164) * x(26) - jvs(165) * x(27) - jvs(166) * x(28) - jvs(167) * x(29) - jvs(168) * x(30) - jvs(169) * &
+                     x(31)) /(jvs(163))
+  x(24) = (x(24) - jvs(153) * x(25) - jvs(154) * x(26) - jvs(155) * x(27) - jvs(156) * x(29) - jvs(157) * x(30) - jvs(158) * &
+                     x(31)) /(jvs(152))
+  x(23) = (x(23) - jvs(142) * x(25) - jvs(143) * x(27) - jvs(144) * x(29) - jvs(145) * x(30)) /(jvs(141))
+  x(22) = (x(22) - jvs(136) * x(25) - jvs(137) * x(27) - jvs(138) * x(29) - jvs(139) * x(30)) /(jvs(135))
+  x(21) = (x(21) - jvs(125) * x(22) - jvs(126) * x(23) - jvs(127) * x(24) - jvs(128) * x(25) - jvs(129) * x(27) - jvs(130) * &
+                     x(28) - jvs(131)&
+            &* x(29) - jvs(132) * x(30) - jvs(133) * x(31) - jvs(134) * x(32)) /(jvs(124))
+  x(20) = (x(20) - jvs(115) * x(22) - jvs(116) * x(23) - jvs(117) * x(25) - jvs(118) * x(26) - jvs(119) * x(27) - jvs(120) * &
+                     x(29) - jvs(121)&
+            &* x(30)) /(jvs(114))
+  x(19) = (x(19) - jvs(108) * x(25) - jvs(109) * x(27) - jvs(110) * x(30) - jvs(111) * x(31)) /(jvs(107))
+  x(18) = (x(18) - jvs(92) * x(19) - jvs(93) * x(20) - jvs(94) * x(22) - jvs(95) * x(23) - jvs(96) * x(24) - jvs(97) * x(25) - &
+                     jvs(98) * x(26)&
+            &- jvs(99) * x(27) - jvs(100) * x(28) - jvs(101) * x(29) - jvs(102) * x(30) - jvs(103) * x(31) - jvs(104) * x(32)) &
+                     /(jvs(91))
+  x(17) = (x(17) - jvs(81) * x(22) - jvs(82) * x(25) - jvs(83) * x(27) - jvs(84) * x(29)) /(jvs(80))
+  x(16) = (x(16) - jvs(70) * x(17) - jvs(71) * x(19) - jvs(72) * x(21) - jvs(73) * x(22) - jvs(74) * x(23) - jvs(75) * x(24) - &
+                     jvs(76) * x(25)&
+            &- jvs(77) * x(27) - jvs(78) * x(29) - jvs(79) * x(30)) /(jvs(69))
+  x(15) = (x(15) - jvs(64) * x(19) - jvs(65) * x(22) - jvs(66) * x(25) - jvs(67) * x(27)) /(jvs(63))
+  x(14) = (x(14) - jvs(59) * x(27) - jvs(60) * x(30) - jvs(61) * x(31)) /(jvs(58))
+  x(13) = (x(13) - jvs(52) * x(20) - jvs(53) * x(26) - jvs(54) * x(27)) /(jvs(51))
+  x(12) = (x(12) - jvs(45) * x(14) - jvs(46) * x(21) - jvs(47) * x(24) - jvs(48) * x(26) - jvs(49) * x(27) - jvs(50) * x(30)) &
+                     /(jvs(44))
+  x(11) = (x(11) - jvs(41) * x(27) - jvs(42) * x(31)) /(jvs(40))
+  x(10) = (x(10) - jvs(35) * x(26) - jvs(36) * x(27) - jvs(37) * x(28)) /(jvs(34))
+  x(9) = (x(9) - jvs(31) * x(26) - jvs(32) * x(27) - jvs(33) * x(31)) /(jvs(30))
+  x(8) = (x(8) - jvs(22) * x(13) - jvs(23) * x(20) - jvs(24) * x(22) - jvs(25) * x(23) - jvs(26) * x(27) - jvs(27) * x(29) - &
+                     jvs(28) * x(30) - jvs(29)&
+           &* x(31)) /(jvs(21))
+  x(7) = (x(7) - jvs(20) * x(27)) /(jvs(19))
+  x(6) = (x(6) - jvs(17) * x(26) - jvs(18) * x(30)) /(jvs(16))
+  x(5) = (x(5) - jvs(15) * x(27)) /(jvs(14))
+  x(4) = (x(4) - jvs(10) * x(14) - jvs(11) * x(26) - jvs(12) * x(27) - jvs(13) * x(30)) /(jvs(9))
+  x(3) = (x(3) - jvs(7) * x(26) - jvs(8) * x(32)) /(jvs(6))
+  x(2) = (x(2) - jvs(4) * x(27) - jvs(5) * x(28)) /(jvs(3))
+  x(1) = (x(1) - jvs(2) * x(25)) /(jvs(1))
+      
+END SUBROUTINE kppsolve
+ 
+SUBROUTINE jac_sp(v, f, rct, jvs)
+
+! V - Concentrations of variable species (local)
+  REAL(kind=dp):: v(nvar)
+! F - Concentrations of fixed species (local)
+  REAL(kind=dp):: f(nfix)
+! RCT - Rate constants (local)
+  REAL(kind=dp):: rct(nreact)
+! JVS - sparse Jacobian of variables
+  REAL(kind=dp):: jvs(lu_nonzero)
+
+
+! Local variables
+! B - Temporary array
+  REAL(kind=dp):: b(138)
+
+! B(1) = dA(1)/dV(26)
+  b(1) = rct(1)
+! B(2) = dA(2)/dV(25)
+  b(2) = rct(2)
+! B(3) = dA(3)/dV(25)
+  b(3) = rct(3)
+! B(4) = dA(4)/dV(30)
+  b(4) = rct(4)
+! B(5) = dA(5)/dV(9)
+  b(5) = rct(5)
+! B(6) = dA(6)/dV(2)
+  b(6) = rct(6)
+! B(7) = dA(7)/dV(21)
+  b(7) = rct(7)
+! B(8) = dA(8)/dV(21)
+  b(8) = rct(8)
+! B(9) = dA(9)/dV(24)
+  b(9) = rct(9)
+! B(10) = dA(10)/dV(19)
+  b(10) = rct(10)
+! B(11) = dA(11)/dV(15)
+  b(11) = rct(11)
+! B(12) = dA(12)/dV(29)
+  b(12) = rct(12)
+! B(13) = dA(13)/dV(25)
+  b(13) = rct(13) * v(31)
+! B(14) = dA(13)/dV(31)
+  b(14) = rct(13) * v(25)
+! B(15) = dA(14)/dV(26)
+  b(15) = rct(14) * v(29)
+! B(16) = dA(14)/dV(29)
+  b(16) = rct(14) * v(26)
+! B(17) = dA(15)/dV(26)
+  b(17) = rct(15) * v(29)
+! B(18) = dA(15)/dV(29)
+  b(18) = rct(15) * v(26)
+! B(19) = dA(16)/dV(29)
+  b(19) = rct(16) * v(31)
+! B(20) = dA(16)/dV(31)
+  b(20) = rct(16) * v(29)
+! B(21) = dA(17)/dV(25)
+  b(21) = rct(17) * v(26)
+! B(22) = dA(17)/dV(26)
+  b(22) = rct(17) * v(25)
+! B(23) = dA(18)/dV(1)
+  b(23) = rct(18)
+! B(24) = dA(19)/dV(1)
+  b(24) = rct(19) * f(1)
+! B(26) = dA(20)/dV(25)
+  b(26) = rct(20) * v(27)
+! B(27) = dA(20)/dV(27)
+  b(27) = rct(20) * v(25)
+! B(28) = dA(21)/dV(25)
+  b(28) = rct(21) * v(28)
+! B(29) = dA(21)/dV(28)
+  b(29) = rct(21) * v(25)
+! B(30) = dA(22)/dV(30)
+  b(30) = rct(22) * v(31)
+! B(31) = dA(22)/dV(31)
+  b(31) = rct(22) * v(30)
+! B(32) = dA(23)/dV(26)
+  b(32) = rct(23) * v(30)
+! B(33) = dA(23)/dV(30)
+  b(33) = rct(23) * v(26)
+! B(34) = dA(24)/dV(26)
+  b(34) = rct(24) * v(30)
+! B(35) = dA(24)/dV(30)
+  b(35) = rct(24) * v(26)
+! B(36) = dA(25)/dV(6)
+  b(36) = rct(25) * f(1)
+! B(38) = dA(26)/dV(6)
+  b(38) = rct(26)
+! B(39) = dA(27)/dV(31)
+  b(39) = rct(27) * 2* v(31)
+! B(40) = dA(28)/dV(26)
+  b(40) = rct(28) * v(31) * f(1)
+! B(41) = dA(28)/dV(31)
+  b(41) = rct(28) * v(26) * f(1)
+! B(43) = dA(29)/dV(27)
+  b(43) = rct(29) * v(31)
+! B(44) = dA(29)/dV(31)
+  b(44) = rct(29) * v(27)
+! B(45) = dA(30)/dV(9)
+  b(45) = rct(30) * v(27)
+! B(46) = dA(30)/dV(27)
+  b(46) = rct(30) * v(9)
+! B(47) = dA(31)/dV(9)
+  b(47) = rct(31) * 2* v(9)
+! B(48) = dA(32)/dV(26)
+  b(48) = rct(32) * v(27)
+! B(49) = dA(32)/dV(27)
+  b(49) = rct(32) * v(26)
+! B(50) = dA(33)/dV(12)
+  b(50) = rct(33) * v(27)
+! B(51) = dA(33)/dV(27)
+  b(51) = rct(33) * v(12)
+! B(52) = dA(34)/dV(28)
+  b(52) = rct(34) * v(31)
+! B(53) = dA(34)/dV(31)
+  b(53) = rct(34) * v(28)
+! B(54) = dA(35)/dV(26)
+  b(54) = rct(35) * v(28)
+! B(55) = dA(35)/dV(28)
+  b(55) = rct(35) * v(26)
+! B(56) = dA(36)/dV(10)
+  b(56) = rct(36)
+! B(57) = dA(37)/dV(10)
+  b(57) = rct(37) * v(27)
+! B(58) = dA(37)/dV(27)
+  b(58) = rct(37) * v(10)
+! B(59) = dA(38)/dV(28)
+  b(59) = rct(38) * 2* v(28)
+! B(60) = dA(39)/dV(28)
+  b(60) = rct(39) * 2* v(28) * f(1)
+! B(62) = dA(40)/dV(2)
+  b(62) = rct(40) * v(27)
+! B(63) = dA(40)/dV(27)
+  b(63) = rct(40) * v(2)
+! B(64) = dA(41)/dV(16)
+  b(64) = rct(41) * v(27)
+! B(65) = dA(41)/dV(27)
+  b(65) = rct(41) * v(16)
+! B(66) = dA(42)/dV(21)
+  b(66) = rct(42) * v(27)
+! B(67) = dA(42)/dV(27)
+  b(67) = rct(42) * v(21)
+! B(68) = dA(43)/dV(21)
+  b(68) = rct(43) * v(29)
+! B(69) = dA(43)/dV(29)
+  b(69) = rct(43) * v(21)
+! B(70) = dA(44)/dV(21)
+  b(70) = rct(44) * v(30)
+! B(71) = dA(44)/dV(30)
+  b(71) = rct(44) * v(21)
+! B(72) = dA(45)/dV(24)
+  b(72) = rct(45) * v(29)
+! B(73) = dA(45)/dV(29)
+  b(73) = rct(45) * v(24)
+! B(74) = dA(46)/dV(24)
+  b(74) = rct(46) * v(27)
+! B(75) = dA(46)/dV(27)
+  b(75) = rct(46) * v(24)
+! B(76) = dA(47)/dV(24)
+  b(76) = rct(47) * v(30)
+! B(77) = dA(47)/dV(30)
+  b(77) = rct(47) * v(24)
+! B(78) = dA(48)/dV(31)
+  b(78) = rct(48) * v(32)
+! B(79) = dA(48)/dV(32)
+  b(79) = rct(48) * v(31)
+! B(80) = dA(49)/dV(26)
+  b(80) = rct(49) * v(32)
+! B(81) = dA(49)/dV(32)
+  b(81) = rct(49) * v(26)
+! B(82) = dA(50)/dV(3)
+  b(82) = rct(50)
+! B(83) = dA(51)/dV(32)
+  b(83) = rct(51) * 2* v(32)
+! B(84) = dA(52)/dV(28)
+  b(84) = rct(52) * v(32)
+! B(85) = dA(52)/dV(32)
+  b(85) = rct(52) * v(28)
+! B(86) = dA(53)/dV(27)
+  b(86) = rct(53)
+! B(87) = dA(54)/dV(20)
+  b(87) = rct(54) * v(27)
+! B(88) = dA(54)/dV(27)
+  b(88) = rct(54) * v(20)
+! B(89) = dA(55)/dV(13)
+  b(89) = rct(55)
+! B(90) = dA(56)/dV(13)
+  b(90) = rct(56)
+! B(91) = dA(57)/dV(13)
+  b(91) = rct(57) * v(26)
+! B(92) = dA(57)/dV(26)
+  b(92) = rct(57) * v(13)
+! B(93) = dA(58)/dV(23)
+  b(93) = rct(58) * v(29)
+! B(94) = dA(58)/dV(29)
+  b(94) = rct(58) * v(23)
+! B(95) = dA(59)/dV(23)
+  b(95) = rct(59) * v(27)
+! B(96) = dA(59)/dV(27)
+  b(96) = rct(59) * v(23)
+! B(97) = dA(60)/dV(23)
+  b(97) = rct(60) * v(25)
+! B(98) = dA(60)/dV(25)
+  b(98) = rct(60) * v(23)
+! B(99) = dA(61)/dV(23)
+  b(99) = rct(61) * v(30)
+! B(100) = dA(61)/dV(30)
+  b(100) = rct(61) * v(23)
+! B(101) = dA(62)/dV(17)
+  b(101) = rct(62) * v(29)
+! B(102) = dA(62)/dV(29)
+  b(102) = rct(62) * v(17)
+! B(103) = dA(63)/dV(17)
+  b(103) = rct(63) * v(27)
+! B(104) = dA(63)/dV(27)
+  b(104) = rct(63) * v(17)
+! B(105) = dA(64)/dV(17)
+  b(105) = rct(64) * v(25)
+! B(106) = dA(64)/dV(25)
+  b(106) = rct(64) * v(17)
+! B(107) = dA(65)/dV(5)
+  b(107) = rct(65) * v(27)
+! B(108) = dA(65)/dV(27)
+  b(108) = rct(65) * v(5)
+! B(109) = dA(66)/dV(11)
+  b(109) = rct(66) * v(31)
+! B(110) = dA(66)/dV(31)
+  b(110) = rct(66) * v(11)
+! B(111) = dA(67)/dV(11)
+  b(111) = rct(67)
+! B(112) = dA(68)/dV(14)
+  b(112) = rct(68) * v(27)
+! B(113) = dA(68)/dV(27)
+  b(113) = rct(68) * v(14)
+! B(114) = dA(69)/dV(14)
+  b(114) = rct(69) * v(30)
+! B(115) = dA(69)/dV(30)
+  b(115) = rct(69) * v(14)
+! B(116) = dA(70)/dV(4)
+  b(116) = rct(70) * v(26)
+! B(117) = dA(70)/dV(26)
+  b(117) = rct(70) * v(4)
+! B(118) = dA(71)/dV(7)
+  b(118) = rct(71) * v(27)
+! B(119) = dA(71)/dV(27)
+  b(119) = rct(71) * v(7)
+! B(120) = dA(72)/dV(19)
+  b(120) = rct(72) * v(27)
+! B(121) = dA(72)/dV(27)
+  b(121) = rct(72) * v(19)
+! B(122) = dA(73)/dV(19)
+  b(122) = rct(73) * v(25)
+! B(123) = dA(73)/dV(25)
+  b(123) = rct(73) * v(19)
+! B(124) = dA(74)/dV(15)
+  b(124) = rct(74) * v(27)
+! B(125) = dA(74)/dV(27)
+  b(125) = rct(74) * v(15)
+! B(126) = dA(75)/dV(22)
+  b(126) = rct(75) * v(29)
+! B(127) = dA(75)/dV(29)
+  b(127) = rct(75) * v(22)
+! B(128) = dA(76)/dV(22)
+  b(128) = rct(76) * v(27)
+! B(129) = dA(76)/dV(27)
+  b(129) = rct(76) * v(22)
+! B(130) = dA(77)/dV(22)
+  b(130) = rct(77) * v(25)
+! B(131) = dA(77)/dV(25)
+  b(131) = rct(77) * v(22)
+! B(132) = dA(78)/dV(22)
+  b(132) = rct(78) * v(30)
+! B(133) = dA(78)/dV(30)
+  b(133) = rct(78) * v(22)
+! B(134) = dA(79)/dV(18)
+  b(134) = rct(79) * v(31)
+! B(135) = dA(79)/dV(31)
+  b(135) = rct(79) * v(18)
+! B(136) = dA(80)/dV(18)
+  b(136) = rct(80) * 2* v(18)
+! B(137) = dA(81)/dV(8)
+  b(137) = rct(81) * v(31)
+! B(138) = dA(81)/dV(31)
+  b(138) = rct(81) * v(8)
+
+! Construct the Jacobian terms from B's
+! JVS(1) = Jac_FULL(1,1)
+  jvs(1) = - b(23) - b(24)
+! JVS(2) = Jac_FULL(1,25)
+  jvs(2) = b(3)
+! JVS(3) = Jac_FULL(2,2)
+  jvs(3) = - b(6) - b(62)
+! JVS(4) = Jac_FULL(2,27)
+  jvs(4) = - b(63)
+! JVS(5) = Jac_FULL(2,28)
+  jvs(5) = b(59) + b(60)
+! JVS(6) = Jac_FULL(3,3)
+  jvs(6) = - b(82)
+! JVS(7) = Jac_FULL(3,26)
+  jvs(7) = b(80)
+! JVS(8) = Jac_FULL(3,32)
+  jvs(8) = b(81)
+! JVS(9) = Jac_FULL(4,4)
+  jvs(9) = - b(116)
+! JVS(10) = Jac_FULL(4,14)
+  jvs(10) = 0.4* b(112) + b(114)
+! JVS(11) = Jac_FULL(4,26)
+  jvs(11) = - b(117)
+! JVS(12) = Jac_FULL(4,27)
+  jvs(12) = 0.4* b(113)
+! JVS(13) = Jac_FULL(4,30)
+  jvs(13) = b(115)
+! JVS(14) = Jac_FULL(5,5)
+  jvs(14) = - b(107)
+! JVS(15) = Jac_FULL(5,27)
+  jvs(15) = - b(108)
+! JVS(16) = Jac_FULL(6,6)
+  jvs(16) = - b(36) - b(38)
+! JVS(17) = Jac_FULL(6,26)
+  jvs(17) = b(34)
+! JVS(18) = Jac_FULL(6,30)
+  jvs(18) = b(35)
+! JVS(19) = Jac_FULL(7,7)
+  jvs(19) = - b(118)
+! JVS(20) = Jac_FULL(7,27)
+  jvs(20) = - b(119)
+! JVS(21) = Jac_FULL(8,8)
+  jvs(21) = - b(137)
+! JVS(22) = Jac_FULL(8,13)
+  jvs(22) = 0.04* b(89)
+! JVS(23) = Jac_FULL(8,20)
+  jvs(23) = 0.13* b(87)
+! JVS(24) = Jac_FULL(8,22)
+  jvs(24) = 0.13* b(128) + b(132)
+! JVS(25) = Jac_FULL(8,23)
+  jvs(25) = 0.02* b(93) + 0.09* b(99)
+! JVS(26) = Jac_FULL(8,27)
+  jvs(26) = 0.13* b(88) + 0.13* b(129)
+! JVS(27) = Jac_FULL(8,29)
+  jvs(27) = 0.02* b(94)
+! JVS(28) = Jac_FULL(8,30)
+  jvs(28) = 0.09* b(100) + b(133)
+! JVS(29) = Jac_FULL(8,31)
+  jvs(29) = - b(138)
+! JVS(30) = Jac_FULL(9,9)
+  jvs(30) = - b(5) - b(45) - 2* b(47)
+! JVS(31) = Jac_FULL(9,26)
+  jvs(31) = 2* b(40)
+! JVS(32) = Jac_FULL(9,27)
+  jvs(32) = b(43) - b(46)
+! JVS(33) = Jac_FULL(9,31)
+  jvs(33) = 2* b(41) + b(44)
+! JVS(34) = Jac_FULL(10,10)
+  jvs(34) = - b(56) - b(57)
+! JVS(35) = Jac_FULL(10,26)
+  jvs(35) = b(54)
+! JVS(36) = Jac_FULL(10,27)
+  jvs(36) = - b(58)
+! JVS(37) = Jac_FULL(10,28)
+  jvs(37) = b(55)
+! JVS(38) = Jac_FULL(11,5)
+  jvs(38) = 0.56* b(107)
+! JVS(39) = Jac_FULL(11,7)
+  jvs(39) = 0.3* b(118)
+! JVS(40) = Jac_FULL(11,11)
+  jvs(40) = - b(109) - b(111)
+! JVS(41) = Jac_FULL(11,27)
+  jvs(41) = 0.56* b(108) + 0.3* b(119)
+! JVS(42) = Jac_FULL(11,31)
+  jvs(42) = - b(110)
+! JVS(43) = Jac_FULL(12,6)
+  jvs(43) = 2* b(36)
+! JVS(44) = Jac_FULL(12,12)
+  jvs(44) = - b(50)
+! JVS(45) = Jac_FULL(12,14)
+  jvs(45) = b(114)
+! JVS(46) = Jac_FULL(12,21)
+  jvs(46) = b(70)
+! JVS(47) = Jac_FULL(12,24)
+  jvs(47) = b(76)
+! JVS(48) = Jac_FULL(12,26)
+  jvs(48) = b(48)
+! JVS(49) = Jac_FULL(12,27)
+  jvs(49) = b(49) - b(51)
+! JVS(50) = Jac_FULL(12,30)
+  jvs(50) = b(71) + b(77) + b(115)
+! JVS(51) = Jac_FULL(13,13)
+  jvs(51) = - 0.98* b(89) - b(90) - b(91)
+! JVS(52) = Jac_FULL(13,20)
+  jvs(52) = 0.76* b(87)
+! JVS(53) = Jac_FULL(13,26)
+  jvs(53) = - b(92)
+! JVS(54) = Jac_FULL(13,27)
+  jvs(54) = 0.76* b(88)
+! JVS(55) = Jac_FULL(14,5)
+  jvs(55) = 0.36* b(107)
+! JVS(56) = Jac_FULL(14,7)
+  jvs(56) = 0.2* b(118)
+! JVS(57) = Jac_FULL(14,11)
+  jvs(57) = b(111)
+! JVS(58) = Jac_FULL(14,14)
+  jvs(58) = - b(112) - b(114)
+! JVS(59) = Jac_FULL(14,27)
+  jvs(59) = 0.36* b(108) - b(113) + 0.2* b(119)
+! JVS(60) = Jac_FULL(14,30)
+  jvs(60) = - b(115)
+! JVS(61) = Jac_FULL(14,31)
+  jvs(61) = 0
+! JVS(62) = Jac_FULL(15,7)
+  jvs(62) = 0.8* b(118)
+! JVS(63) = Jac_FULL(15,15)
+  jvs(63) = - b(11) - b(124)
+! JVS(64) = Jac_FULL(15,19)
+  jvs(64) = 0.2* b(122)
+! JVS(65) = Jac_FULL(15,22)
+  jvs(65) = 0.4* b(128) + 0.2* b(130)
+! JVS(66) = Jac_FULL(15,25)
+  jvs(66) = 0.2* b(123) + 0.2* b(131)
+! JVS(67) = Jac_FULL(15,27)
+  jvs(67) = 0.8* b(119) - b(125) + 0.4* b(129)
+! JVS(68) = Jac_FULL(16,15)
+  jvs(68) = b(11)
+! JVS(69) = Jac_FULL(16,16)
+  jvs(69) = - b(64)
+! JVS(70) = Jac_FULL(16,17)
+  jvs(70) = b(101) + 0.42* b(105)
+! JVS(71) = Jac_FULL(16,19)
+  jvs(71) = b(10) + 2* b(120) + 0.69* b(122)
+! JVS(72) = Jac_FULL(16,21)
+  jvs(72) = b(7) + b(8) + b(66) + b(68) + b(70)
+! JVS(73) = Jac_FULL(16,22)
+  jvs(73) = 0.5* b(126) + 0.06* b(130)
+! JVS(74) = Jac_FULL(16,23)
+  jvs(74) = 0.3* b(93) + 0.33* b(97)
+! JVS(75) = Jac_FULL(16,24)
+  jvs(75) = b(9)
+! JVS(76) = Jac_FULL(16,25)
+  jvs(76) = 0.33* b(98) + 0.42* b(106) + 0.69* b(123) + 0.06* b(131)
+! JVS(77) = Jac_FULL(16,27)
+  jvs(77) = - b(65) + b(67) + 2* b(121)
+! JVS(78) = Jac_FULL(16,29)
+  jvs(78) = b(69) + 0.3* b(94) + b(102) + 0.5* b(127)
+! JVS(79) = Jac_FULL(16,30)
+  jvs(79) = b(71)
+! JVS(80) = Jac_FULL(17,17)
+  jvs(80) = - b(101) - b(103) - b(105)
+! JVS(81) = Jac_FULL(17,22)
+  jvs(81) = 0.45* b(126) + b(128) + 0.55* b(130)
+! JVS(82) = Jac_FULL(17,25)
+  jvs(82) = - b(106) + 0.55* b(131)
+! JVS(83) = Jac_FULL(17,27)
+  jvs(83) = - b(104) + b(129)
+! JVS(84) = Jac_FULL(17,29)
+  jvs(84) = - b(102) + 0.45* b(127)
+! JVS(85) = Jac_FULL(18,5)
+  jvs(85) = 0.08* b(107)
+! JVS(86) = Jac_FULL(18,7)
+  jvs(86) = 0.5* b(118)
+! JVS(87) = Jac_FULL(18,13)
+  jvs(87) = 0.96* b(89)
+! JVS(88) = Jac_FULL(18,14)
+  jvs(88) = 0.6* b(112)
+! JVS(89) = Jac_FULL(18,15)
+  jvs(89) = b(124)
+! JVS(90) = Jac_FULL(18,17)
+  jvs(90) = 0.7* b(101) + b(103)
+! JVS(91) = Jac_FULL(18,18)
+  jvs(91) = - b(134) - 2* b(136)
+! JVS(92) = Jac_FULL(18,19)
+  jvs(92) = b(120) + 0.03* b(122)
+! JVS(93) = Jac_FULL(18,20)
+  jvs(93) = 0.87* b(87)
+! JVS(94) = Jac_FULL(18,22)
+  jvs(94) = 0.5* b(126) + b(128)
+! JVS(95) = Jac_FULL(18,23)
+  jvs(95) = 0.28* b(93) + b(95) + 0.22* b(97) + 0.91* b(99)
+! JVS(96) = Jac_FULL(18,24)
+  jvs(96) = b(9)
+! JVS(97) = Jac_FULL(18,25)
+  jvs(97) = 0.22* b(98) + 0.03* b(123)
+! JVS(98) = Jac_FULL(18,26)
+  jvs(98) = 0
+! JVS(99) = Jac_FULL(18,27)
+  jvs(99) = b(86) + 0.87* b(88) + b(96) + b(104) + 0.08* b(108) + 0.6* b(113) + 0.5* b(119) + b(121) + b(125) + b(129)
+! JVS(100) = Jac_FULL(18,28)
+  jvs(100) = 0.79* b(84)
+! JVS(101) = Jac_FULL(18,29)
+  jvs(101) = 0.28* b(94) + 0.7* b(102) + 0.5* b(127)
+! JVS(102) = Jac_FULL(18,30)
+  jvs(102) = 0.91* b(100)
+! JVS(103) = Jac_FULL(18,31)
+  jvs(103) = b(78) - b(135)
+! JVS(104) = Jac_FULL(18,32)
+  jvs(104) = b(79) + 2* b(83) + 0.79* b(85)
+! JVS(105) = Jac_FULL(19,11)
+  jvs(105) = 0.9* b(109)
+! JVS(106) = Jac_FULL(19,14)
+  jvs(106) = 0.3* b(112)
+! JVS(107) = Jac_FULL(19,19)
+  jvs(107) = - b(10) - b(120) - b(122)
+! JVS(108) = Jac_FULL(19,25)
+  jvs(108) = - b(123)
+! JVS(109) = Jac_FULL(19,27)
+  jvs(109) = 0.3* b(113) - b(121)
+! JVS(110) = Jac_FULL(19,30)
+  jvs(110) = 0
+! JVS(111) = Jac_FULL(19,31)
+  jvs(111) = 0.9* b(110)
+! JVS(112) = Jac_FULL(20,7)
+  jvs(112) = 1.1* b(118)
+! JVS(113) = Jac_FULL(20,13)
+  jvs(113) = - 2.1* b(89)
+! JVS(114) = Jac_FULL(20,20)
+  jvs(114) = - 1.11* b(87)
+! JVS(115) = Jac_FULL(20,22)
+  jvs(115) = 0.9* b(126) + 0.1* b(130)
+! JVS(116) = Jac_FULL(20,23)
+  jvs(116) = 0.22* b(93) - b(95) - b(97) - b(99)
+! JVS(117) = Jac_FULL(20,25)
+  jvs(117) = - b(98) + 0.1* b(131)
+! JVS(118) = Jac_FULL(20,26)
+  jvs(118) = 0
+! JVS(119) = Jac_FULL(20,27)
+  jvs(119) = - 1.11* b(88) - b(96) + 1.1* b(119)
+! JVS(120) = Jac_FULL(20,29)
+  jvs(120) = 0.22* b(94) + 0.9* b(127)
+! JVS(121) = Jac_FULL(20,30)
+  jvs(121) = - b(100)
+! JVS(122) = Jac_FULL(21,17)
+  jvs(122) = b(101) + 1.56* b(103) + b(105)
+! JVS(123) = Jac_FULL(21,19)
+  jvs(123) = b(120) + 0.7* b(122)
+! JVS(124) = Jac_FULL(21,21)
+  jvs(124) = - b(7) - b(8) - b(66) - b(68) - b(70)
+! JVS(125) = Jac_FULL(21,22)
+  jvs(125) = b(128) + b(130)
+! JVS(126) = Jac_FULL(21,23)
+  jvs(126) = 0.2* b(93) + b(95) + 0.74* b(97) + b(99)
+! JVS(127) = Jac_FULL(21,24)
+  jvs(127) = b(9)
+! JVS(128) = Jac_FULL(21,25)
+  jvs(128) = 0.74* b(98) + b(106) + 0.7* b(123) + b(131)
+! JVS(129) = Jac_FULL(21,27)
+  jvs(129) = - b(67) + b(86) + b(96) + 1.56* b(104) + b(121) + b(129)
+! JVS(130) = Jac_FULL(21,28)
+  jvs(130) = 0.79* b(84)
+! JVS(131) = Jac_FULL(21,29)
+  jvs(131) = - b(69) + 0.2* b(94) + b(102)
+! JVS(132) = Jac_FULL(21,30)
+  jvs(132) = - b(71) + b(100)
+! JVS(133) = Jac_FULL(21,31)
+  jvs(133) = b(78)
+! JVS(134) = Jac_FULL(21,32)
+  jvs(134) = b(79) + 2* b(83) + 0.79* b(85)
+! JVS(135) = Jac_FULL(22,22)
+  jvs(135) = - b(126) - b(128) - b(130) - b(132)
+! JVS(136) = Jac_FULL(22,25)
+  jvs(136) = - b(131)
+! JVS(137) = Jac_FULL(22,27)
+  jvs(137) = - b(129)
+! JVS(138) = Jac_FULL(22,29)
+  jvs(138) = - b(127)
+! JVS(139) = Jac_FULL(22,30)
+  jvs(139) = - b(133)
+! JVS(140) = Jac_FULL(23,22)
+  jvs(140) = 0.55* b(126)
+! JVS(141) = Jac_FULL(23,23)
+  jvs(141) = - b(93) - b(95) - b(97) - b(99)
+! JVS(142) = Jac_FULL(23,25)
+  jvs(142) = - b(98)
+! JVS(143) = Jac_FULL(23,27)
+  jvs(143) = - b(96)
+! JVS(144) = Jac_FULL(23,29)
+  jvs(144) = - b(94) + 0.55* b(127)
+! JVS(145) = Jac_FULL(23,30)
+  jvs(145) = - b(100)
+! JVS(146) = Jac_FULL(24,13)
+  jvs(146) = 1.1* b(89)
+! JVS(147) = Jac_FULL(24,17)
+  jvs(147) = 0.22* b(103)
+! JVS(148) = Jac_FULL(24,19)
+  jvs(148) = 0.03* b(122)
+! JVS(149) = Jac_FULL(24,20)
+  jvs(149) = 0.11* b(87)
+! JVS(150) = Jac_FULL(24,22)
+  jvs(150) = 0.8* b(126) + 0.2* b(128) + 0.4* b(130)
+! JVS(151) = Jac_FULL(24,23)
+  jvs(151) = 0.63* b(93) + b(95) + 0.5* b(97) + b(99)
+! JVS(152) = Jac_FULL(24,24)
+  jvs(152) = - b(9) - b(72) - b(74) - b(76)
+! JVS(153) = Jac_FULL(24,25)
+  jvs(153) = 0.5* b(98) + 0.03* b(123) + 0.4* b(131)
+! JVS(154) = Jac_FULL(24,26)
+  jvs(154) = 0
+! JVS(155) = Jac_FULL(24,27)
+  jvs(155) = - b(75) + 0.11* b(88) + b(96) + 0.22* b(104) + 0.2* b(129)
+! JVS(156) = Jac_FULL(24,29)
+  jvs(156) = - b(73) + 0.63* b(94) + 0.8* b(127)
+! JVS(157) = Jac_FULL(24,30)
+  jvs(157) = - b(77) + b(100)
+! JVS(158) = Jac_FULL(24,31)
+  jvs(158) = 0
+! JVS(159) = Jac_FULL(25,17)
+  jvs(159) = - b(105)
+! JVS(160) = Jac_FULL(25,19)
+  jvs(160) = - b(122)
+! JVS(161) = Jac_FULL(25,22)
+  jvs(161) = - b(130)
+! JVS(162) = Jac_FULL(25,23)
+  jvs(162) = - b(97)
+! JVS(163) = Jac_FULL(25,25)
+  jvs(163) = - b(2) - b(3) - b(13) - b(21) - b(26) - b(28) - b(98) - b(106) - b(123) - b(131)
+! JVS(164) = Jac_FULL(25,26)
+  jvs(164) = - b(22)
+! JVS(165) = Jac_FULL(25,27)
+  jvs(165) = - b(27)
+! JVS(166) = Jac_FULL(25,28)
+  jvs(166) = - b(29)
+! JVS(167) = Jac_FULL(25,29)
+  jvs(167) = b(12)
+! JVS(168) = Jac_FULL(25,30)
+  jvs(168) = 0
+! JVS(169) = Jac_FULL(25,31)
+  jvs(169) = - b(14)
+! JVS(170) = Jac_FULL(26,3)
+  jvs(170) = b(82)
+! JVS(171) = Jac_FULL(26,4)
+  jvs(171) = - b(116)
+! JVS(172) = Jac_FULL(26,6)
+  jvs(172) = b(38)
+! JVS(173) = Jac_FULL(26,9)
+  jvs(173) = b(45) + b(47)
+! JVS(174) = Jac_FULL(26,10)
+  jvs(174) = b(56) + b(57)
+! JVS(175) = Jac_FULL(26,11)
+  jvs(175) = 0.9* b(109)
+! JVS(176) = Jac_FULL(26,13)
+  jvs(176) = - b(91)
+! JVS(177) = Jac_FULL(26,14)
+  jvs(177) = 0
+! JVS(178) = Jac_FULL(26,18)
+  jvs(178) = b(134)
+! JVS(179) = Jac_FULL(26,19)
+  jvs(179) = 0
+! JVS(180) = Jac_FULL(26,20)
+  jvs(180) = 0
+! JVS(181) = Jac_FULL(26,22)
+  jvs(181) = 0
+! JVS(182) = Jac_FULL(26,23)
+  jvs(182) = b(99)
+! JVS(183) = Jac_FULL(26,24)
+  jvs(183) = 0
+! JVS(184) = Jac_FULL(26,25)
+  jvs(184) = b(13) - b(21)
+! JVS(185) = Jac_FULL(26,26)
+  jvs(185) = - b(1) - b(15) - b(17) - b(22) - b(34) - b(40) - b(48) - b(54) - b(80) - b(92) - b(117)
+! JVS(186) = Jac_FULL(26,27)
+  jvs(186) = b(46) - b(49) + b(58)
+! JVS(187) = Jac_FULL(26,28)
+  jvs(187) = b(52) - b(55)
+! JVS(188) = Jac_FULL(26,29)
+  jvs(188) = - b(16) - b(18) + b(19)
+! JVS(189) = Jac_FULL(26,30)
+  jvs(189) = 0.89* b(4) + 2* b(30) - b(35) + b(100)
+! JVS(190) = Jac_FULL(26,31)
+  jvs(190) = b(14) + b(20) + 2* b(31) + 2* b(39) - b(41) + b(53) + b(78) + 0.9* b(110) + b(135)
+! JVS(191) = Jac_FULL(26,32)
+  jvs(191) = b(79) - b(81)
+! JVS(192) = Jac_FULL(27,1)
+  jvs(192) = 2* b(24)
+! JVS(193) = Jac_FULL(27,2)
+  jvs(193) = 2* b(6) - b(62)
+! JVS(194) = Jac_FULL(27,5)
+  jvs(194) = - b(107)
+! JVS(195) = Jac_FULL(27,7)
+  jvs(195) = - b(118)
+! JVS(196) = Jac_FULL(27,9)
+  jvs(196) = b(5) - b(45)
+! JVS(197) = Jac_FULL(27,10)
+  jvs(197) = - b(57)
+! JVS(198) = Jac_FULL(27,12)
+  jvs(198) = - b(50)
+! JVS(199) = Jac_FULL(27,14)
+  jvs(199) = - b(112)
+! JVS(200) = Jac_FULL(27,15)
+  jvs(200) = - b(124)
+! JVS(201) = Jac_FULL(27,16)
+  jvs(201) = - b(64)
+! JVS(202) = Jac_FULL(27,17)
+  jvs(202) = 0.3* b(101) - b(103)
+! JVS(203) = Jac_FULL(27,19)
+  jvs(203) = - b(120) + 0.08* b(122)
+! JVS(204) = Jac_FULL(27,20)
+  jvs(204) = - b(87)
+! JVS(205) = Jac_FULL(27,21)
+  jvs(205) = - b(66) + b(68)
+! JVS(206) = Jac_FULL(27,22)
+  jvs(206) = - b(128) + 0.1* b(130)
+! JVS(207) = Jac_FULL(27,23)
+  jvs(207) = 0.2* b(93) - b(95) + 0.1* b(97)
+! JVS(208) = Jac_FULL(27,24)
+  jvs(208) = b(72) - b(74)
+! JVS(209) = Jac_FULL(27,25)
+  jvs(209) = - b(26) + b(28) + 0.1* b(98) + 0.08* b(123) + 0.1* b(131)
+! JVS(210) = Jac_FULL(27,26)
+  jvs(210) = - b(48)
+! JVS(211) = Jac_FULL(27,27)
+  jvs(211) = - b(27) - b(43) - b(46) - b(49) - b(51) - b(58) - b(63) - b(65) - b(67) - b(75) - b(86) - b(88) - b(96) - b(104) - &
+                     b(108) - b(113) - b(119)&
+               &- b(121) - b(125) - b(129)
+! JVS(212) = Jac_FULL(27,28)
+  jvs(212) = b(29) + b(52) + 0.79* b(84)
+! JVS(213) = Jac_FULL(27,29)
+  jvs(213) = b(69) + b(73) + 0.2* b(94) + 0.3* b(102)
+! JVS(214) = Jac_FULL(27,30)
+  jvs(214) = 0
+! JVS(215) = Jac_FULL(27,31)
+  jvs(215) = - b(44) + b(53)
+! JVS(216) = Jac_FULL(27,32)
+  jvs(216) = 0.79* b(85)
+! JVS(217) = Jac_FULL(28,2)
+  jvs(217) = b(62)
+! JVS(218) = Jac_FULL(28,5)
+  jvs(218) = 0.44* b(107)
+! JVS(219) = Jac_FULL(28,7)
+  jvs(219) = 0.7* b(118)
+! JVS(220) = Jac_FULL(28,10)
+  jvs(220) = b(56)
+! JVS(221) = Jac_FULL(28,11)
+  jvs(221) = 0.9* b(109) + b(111)
+! JVS(222) = Jac_FULL(28,13)
+  jvs(222) = 0.94* b(89) + b(90)
+! JVS(223) = Jac_FULL(28,14)
+  jvs(223) = 0.6* b(112)
+! JVS(224) = Jac_FULL(28,15)
+  jvs(224) = b(11)
+! JVS(225) = Jac_FULL(28,16)
+  jvs(225) = b(64)
+! JVS(226) = Jac_FULL(28,17)
+  jvs(226) = 1.7* b(101) + b(103) + 0.12* b(105)
+! JVS(227) = Jac_FULL(28,19)
+  jvs(227) = b(10) + 2* b(120) + 0.76* b(122)
+! JVS(228) = Jac_FULL(28,20)
+  jvs(228) = 0.11* b(87)
+! JVS(229) = Jac_FULL(28,21)
+  jvs(229) = 2* b(7) + b(66) + b(68) + b(70)
+! JVS(230) = Jac_FULL(28,22)
+  jvs(230) = 0.6* b(126) + 0.67* b(128) + 0.44* b(130)
+! JVS(231) = Jac_FULL(28,23)
+  jvs(231) = 0.38* b(93) + b(95) + 0.44* b(97)
+! JVS(232) = Jac_FULL(28,24)
+  jvs(232) = 2* b(9)
+! JVS(233) = Jac_FULL(28,25)
+  jvs(233) = b(26) - b(28) + 0.44* b(98) + 0.12* b(106) + 0.76* b(123) + 0.44* b(131)
+! JVS(234) = Jac_FULL(28,26)
+  jvs(234) = - b(54)
+! JVS(235) = Jac_FULL(28,27)
+  jvs(235) = b(27) + b(63) + b(65) + b(67) + b(86) + 0.11* b(88) + b(96) + b(104) + 0.44* b(108) + 0.6* b(113) + 0.7* b(119) + 2* &
+                     b(121) + 0.67&
+               &* b(129)
+! JVS(236) = Jac_FULL(28,28)
+  jvs(236) = - b(29) - b(52) - b(55) - 2* b(59) - 2* b(60) - 0.21* b(84)
+! JVS(237) = Jac_FULL(28,29)
+  jvs(237) = b(69) + 0.38* b(94) + 1.7* b(102) + 0.6* b(127)
+! JVS(238) = Jac_FULL(28,30)
+  jvs(238) = b(71)
+! JVS(239) = Jac_FULL(28,31)
+  jvs(239) = - b(53) + b(78) + 0.9* b(110)
+! JVS(240) = Jac_FULL(28,32)
+  jvs(240) = b(79) + 2* b(83) - 0.21* b(85)
+! JVS(241) = Jac_FULL(29,1)
+  jvs(241) = b(23)
+! JVS(242) = Jac_FULL(29,17)
+  jvs(242) = - b(101)
+! JVS(243) = Jac_FULL(29,21)
+  jvs(243) = - b(68)
+! JVS(244) = Jac_FULL(29,22)
+  jvs(244) = - b(126)
+! JVS(245) = Jac_FULL(29,23)
+  jvs(245) = - b(93)
+! JVS(246) = Jac_FULL(29,24)
+  jvs(246) = - b(72)
+! JVS(247) = Jac_FULL(29,25)
+  jvs(247) = b(2)
+! JVS(248) = Jac_FULL(29,26)
+  jvs(248) = b(1) - b(15) - b(17)
+! JVS(249) = Jac_FULL(29,27)
+  jvs(249) = 0
+! JVS(250) = Jac_FULL(29,28)
+  jvs(250) = 0
+! JVS(251) = Jac_FULL(29,29)
+  jvs(251) = - b(12) - b(16) - b(18) - b(19) - b(69) - b(73) - b(94) - b(102) - b(127)
+! JVS(252) = Jac_FULL(29,30)
+  jvs(252) = 0.89* b(4)
+! JVS(253) = Jac_FULL(29,31)
+  jvs(253) = - b(20)
+! JVS(254) = Jac_FULL(29,32)
+  jvs(254) = 0
+! JVS(255) = Jac_FULL(30,6)
+  jvs(255) = b(38)
+! JVS(256) = Jac_FULL(30,12)
+  jvs(256) = b(50)
+! JVS(257) = Jac_FULL(30,14)
+  jvs(257) = - b(114)
+! JVS(258) = Jac_FULL(30,21)
+  jvs(258) = - b(70)
+! JVS(259) = Jac_FULL(30,22)
+  jvs(259) = - b(132)
+! JVS(260) = Jac_FULL(30,23)
+  jvs(260) = - b(99)
+! JVS(261) = Jac_FULL(30,24)
+  jvs(261) = - b(76)
+! JVS(262) = Jac_FULL(30,25)
+  jvs(262) = b(21)
+! JVS(263) = Jac_FULL(30,26)
+  jvs(263) = b(17) + b(22) - b(32) - b(34)
+! JVS(264) = Jac_FULL(30,27)
+  jvs(264) = b(51)
+! JVS(265) = Jac_FULL(30,28)
+  jvs(265) = 0
+! JVS(266) = Jac_FULL(30,29)
+  jvs(266) = b(18)
+! JVS(267) = Jac_FULL(30,30)
+  jvs(267) = - b(4) - b(30) - b(33) - b(35) - b(71) - b(77) - b(100) - b(115) - b(133)
+! JVS(268) = Jac_FULL(30,31)
+  jvs(268) = - b(31)
+! JVS(269) = Jac_FULL(30,32)
+  jvs(269) = 0
+! JVS(270) = Jac_FULL(31,8)
+  jvs(270) = - b(137)
+! JVS(271) = Jac_FULL(31,9)
+  jvs(271) = b(5) + b(47)
+! JVS(272) = Jac_FULL(31,11)
+  jvs(272) = - b(109)
+! JVS(273) = Jac_FULL(31,13)
+  jvs(273) = 0
+! JVS(274) = Jac_FULL(31,18)
+  jvs(274) = - b(134)
+! JVS(275) = Jac_FULL(31,19)
+  jvs(275) = 0
+! JVS(276) = Jac_FULL(31,20)
+  jvs(276) = 0
+! JVS(277) = Jac_FULL(31,22)
+  jvs(277) = 0
+! JVS(278) = Jac_FULL(31,23)
+  jvs(278) = 0
+! JVS(279) = Jac_FULL(31,24)
+  jvs(279) = 0
+! JVS(280) = Jac_FULL(31,25)
+  jvs(280) = - b(13)
+! JVS(281) = Jac_FULL(31,26)
+  jvs(281) = b(1) + b(15) + b(32) - b(40)
+! JVS(282) = Jac_FULL(31,27)
+  jvs(282) = - b(43)
+! JVS(283) = Jac_FULL(31,28)
+  jvs(283) = - b(52)
+! JVS(284) = Jac_FULL(31,29)
+  jvs(284) = b(16) - b(19)
+! JVS(285) = Jac_FULL(31,30)
+  jvs(285) = 0.11* b(4) - b(30) + b(33)
+! JVS(286) = Jac_FULL(31,31)
+  jvs(286) = - b(14) - b(20) - b(31) - 2* b(39) - b(41) - b(44) - b(53) - b(78) - b(110) - b(135) - b(138)
+! JVS(287) = Jac_FULL(31,32)
+  jvs(287) = - b(79)
+! JVS(288) = Jac_FULL(32,3)
+  jvs(288) = b(82)
+! JVS(289) = Jac_FULL(32,15)
+  jvs(289) = b(11) + b(124)
+! JVS(290) = Jac_FULL(32,19)
+  jvs(290) = b(10) + b(120) + 0.62* b(122)
+! JVS(291) = Jac_FULL(32,22)
+  jvs(291) = 0.2* b(128)
+! JVS(292) = Jac_FULL(32,24)
+  jvs(292) = b(72) + b(74) + b(76)
+! JVS(293) = Jac_FULL(32,25)
+  jvs(293) = 0.62* b(123)
+! JVS(294) = Jac_FULL(32,26)
+  jvs(294) = - b(80)
+! JVS(295) = Jac_FULL(32,27)
+  jvs(295) = b(75) + b(121) + b(125) + 0.2* b(129)
+! JVS(296) = Jac_FULL(32,28)
+  jvs(296) = - b(84)
+! JVS(297) = Jac_FULL(32,29)
+  jvs(297) = b(73)
+! JVS(298) = Jac_FULL(32,30)
+  jvs(298) = b(77)
+! JVS(299) = Jac_FULL(32,31)
+  jvs(299) = - b(78)
+! JVS(300) = Jac_FULL(32,32)
+  jvs(300) = - b(79) - b(81) - 2* b(83) - b(85)
+      
+END SUBROUTINE jac_sp
+ 
+  elemental REAL(kind=dp)FUNCTION k_arr (k_298, tdep, temp)
+    ! arrhenius FUNCTION
+
+    REAL,    INTENT(IN):: k_298 ! k at t = 298.15k
+    REAL,    INTENT(IN):: tdep  ! temperature dependence
+    REAL(kind=dp), INTENT(IN):: temp  ! temperature
+
+    intrinsic exp
+
+    k_arr = k_298 * exp(tdep* (1._dp/temp- 3.3540e-3_dp))! 1/298.15=3.3540e-3
+
+  END FUNCTION k_arr
+ 
+SUBROUTINE update_rconst()
+ INTEGER         :: k
+
+  k = is
+
+! Begin INLINED RCONST
+
+
+! End INLINED RCONST
+
+  rconst(1) = (phot(j_no2))
+  rconst(2) = (phot(j_o33p))
+  rconst(3) = (phot(j_o31d))
+  rconst(4) = (phot(j_no3o) + phot(j_no3o2))
+  rconst(5) = (phot(j_hono))
+  rconst(6) = (phot(j_h2o2))
+  rconst(7) = (phot(j_ch2or))
+  rconst(8) = (phot(j_ch2om))
+  rconst(9) = (4.6e-4_dp * phot(j_no2))
+  rconst(10) = (9.04_dp * phot(j_ch2or))
+  rconst(11) = (9.64_dp * phot(j_ch2or))
+  rconst(12) = (arr2(1.4e+3_dp , -1175.0_dp , temp))
+  rconst(13) = (arr2(1.8e-12_dp , + 1370.0_dp , temp))
+  rconst(14) = (9.3e-12_dp)
+  rconst(15) = (arr2(1.6e-13_dp , -687.0_dp , temp))
+  rconst(16) = (arr2(2.2e-13_dp , -602.0_dp , temp))
+  rconst(17) = (arr2(1.2e-13_dp , + 2450.0_dp , temp))
+  rconst(18) = (arr2(1.9e+8_dp , -390.0_dp , temp))
+  rconst(19) = (2.2e-10_dp)
+  rconst(20) = (arr2(1.6e-12_dp , + 940.0_dp , temp))
+  rconst(21) = (arr2(1.4e-14_dp , + 580.0_dp , temp))
+  rconst(22) = (arr2(1.3e-11_dp , -250.0_dp , temp))
+  rconst(23) = (arr2(2.5e-14_dp , + 1230.0_dp , temp))
+  rconst(24) = (arr2(5.3e-13_dp , -256.0_dp , temp))
+  rconst(25) = (1.3e-21_dp)
+  rconst(26) = (arr2(3.5e+14_dp , + 10897.0_dp , temp))
+  rconst(27) = (arr2(1.8e-20_dp , -530.0_dp , temp))
+  rconst(28) = (4.4e-40_dp)
+  rconst(29) = (arr2(4.5e-13_dp , -806.0_dp , temp))
+  rconst(30) = (6.6e-12_dp)
+  rconst(31) = (1.0e-20_dp)
+  rconst(32) = (arr2(1.0e-12_dp , -713.0_dp , temp))
+  rconst(33) = (arr2(5.1e-15_dp , -1000.0_dp , temp))
+  rconst(34) = (arr2(3.7e-12_dp , -240.0_dp , temp))
+  rconst(35) = (arr2(1.2e-13_dp , -749.0_dp , temp))
+  rconst(36) = (arr2(4.8e+13_dp , + 10121.0_dp , temp))
+  rconst(37) = (arr2(1.3e-12_dp , -380.0_dp , temp))
+  rconst(38) = (arr2(5.9e-14_dp , -1150.0_dp , temp))
+  rconst(39) = (arr2(2.2e-38_dp , -5800.0_dp , temp))
+  rconst(40) = (arr2(3.1e-12_dp , + 187.0_dp , temp))
+  rconst(41) = (2.2e-13_dp)
+  rconst(42) = (1.0e-11_dp)
+  rconst(43) = (arr2(3.0e-11_dp , + 1550.0_dp , temp))
+  rconst(44) = (6.3e-16_dp)
+  rconst(45) = (arr2(1.2e-11_dp , + 986.0_dp , temp))
+  rconst(46) = (arr2(7.0e-12_dp , -250.0_dp , temp))
+  rconst(47) = (2.5e-15_dp)
+  rconst(48) = (arr2(5.4e-12_dp , -250.0_dp , temp))
+  rconst(49) = (arr2(8.0e-20_dp , -5500.0_dp , temp))
+  rconst(50) = (arr2(9.4e+16_dp , + 14000.0_dp , temp))
+  rconst(51) = (2.0e-12_dp)
+  rconst(52) = (6.5e-12_dp)
+  rconst(53) = (arr2(1.1e+2_dp , + 1710.0_dp , temp))
+  rconst(54) = (8.1e-13_dp)
+  rconst(55) = (arr2(1.0e+15_dp , + 8000.0_dp , temp))
+  rconst(56) = (1.6e+03_dp)
+  rconst(57) = (1.5e-11_dp)
+  rconst(58) = (arr2(1.2e-11_dp , + 324.0_dp , temp))
+  rconst(59) = (arr2(5.2e-12_dp , -504.0_dp , temp))
+  rconst(60) = (arr2(1.4e-14_dp , + 2105.0_dp , temp))
+  rconst(61) = (7.7e-15_dp)
+  rconst(62) = (arr2(1.0e-11_dp , + 792.0_dp , temp))
+  rconst(63) = (arr2(2.0e-12_dp , -411.0_dp , temp))
+  rconst(64) = (arr2(1.3e-14_dp , + 2633.0_dp , temp))
+  rconst(65) = (arr2(2.1e-12_dp , -322.0_dp , temp))
+  rconst(66) = (8.1e-12_dp)
+  rconst(67) = (4.20_dp)
+  rconst(68) = (4.1e-11_dp)
+  rconst(69) = (2.2e-11_dp)
+  rconst(70) = (1.4e-11_dp)
+  rconst(71) = (arr2(1.7e-11_dp , -116.0_dp , temp))
+  rconst(72) = (3.0e-11_dp)
+  rconst(73) = (arr2(5.4e-17_dp , + 500.0_dp , temp))
+  rconst(74) = (1.70e-11_dp)
+  rconst(75) = (1.80e-11_dp)
+  rconst(76) = (9.6e-11_dp)
+  rconst(77) = (1.2e-17_dp)
+  rconst(78) = (3.2e-13_dp)
+  rconst(79) = (8.1e-12_dp)
+  rconst(80) = (arr2(1.7e-14_dp , -1300.0_dp , temp))
+  rconst(81) = (6.8e-13_dp)
+      
+END SUBROUTINE update_rconst
+ 
+!  END FUNCTION ARR2
+REAL(kind=dp)FUNCTION arr2( a0, b0, temp)
+    REAL(kind=dp):: temp
+    REAL(kind=dp):: a0, b0
+    arr2 = a0 * exp( - b0 / temp)
+END FUNCTION arr2
+ 
+SUBROUTINE initialize_kpp_ctrl(status)
+
+
+  ! i/o
+  INTEGER,         INTENT(OUT):: status
+
+  ! local
+  REAL(dp):: tsum
+  INTEGER  :: i
+
+  ! check fixed time steps
+  tsum = 0.0_dp
+  DO i=1, nmaxfixsteps
+     IF (t_steps(i)< tiny(0.0_dp))exit
+     tsum = tsum + t_steps(i)
+  ENDDO
+
+  nfsteps = i- 1
+
+  l_fixed_step = (nfsteps > 0).and.((tsum - 1.0)< tiny(0.0_dp))
+
+  IF (l_vector)THEN
+     WRITE(*,*) ' MODE             : VECTOR (LENGTH=',VL_DIM,')'
+  ELSE
+     WRITE(*,*) ' MODE             : SCALAR'
+  ENDIF
+  !
+  WRITE(*,*) ' DE-INDEXING MODE :',I_LU_DI
+  !
+  WRITE(*,*) ' ICNTRL           : ',icntrl
+  WRITE(*,*) ' RCNTRL           : ',rcntrl
+  !
+  ! note: this is ONLY meaningful for vectorized (kp4)rosenbrock- methods
+  IF (l_vector)THEN
+     IF (l_fixed_step)THEN
+        WRITE(*,*) ' TIME STEPS       : FIXED (',t_steps(1:nfsteps),')'
+     ELSE
+        WRITE(*,*) ' TIME STEPS       : AUTOMATIC'
+     ENDIF
+  ELSE
+     WRITE(*,*) ' TIME STEPS       : AUTOMATIC '//&
+          &'(t_steps (CTRL_KPP) ignored in SCALAR MODE)'
+  ENDIF
+  ! mz_pj_20070531- 
+
+  status = 0
+
+
+END SUBROUTINE initialize_kpp_ctrl
+ 
+SUBROUTINE error_output(c, ierr, pe)
+
+
+  INTEGER, INTENT(IN):: ierr
+  INTEGER, INTENT(IN):: pe
+  REAL(dp), DIMENSION(:), INTENT(IN):: c
+
+  write(6,*) 'ERROR in chem_gasphase_mod ',ierr,C(1)
+
+
+END SUBROUTINE error_output
+ 
+      SUBROUTINE wscal(n, alpha, x, incx)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+!     constant times a vector: x(1:N) <- Alpha*x(1:N) 
+!     only for incX=incY=1
+!     after BLAS
+!     replace this by the function from the optimized BLAS implementation:
+!         CALL SSCAL(N,Alpha,X,1) or  CALL DSCAL(N,Alpha,X,1)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+
+      INTEGER  :: i, incx, m, mp1, n
+      REAL(kind=dp) :: x(n), alpha
+      REAL(kind=dp), PARAMETER  :: zero=0.0_dp, one=1.0_dp
+
+      IF (alpha .eq. one)RETURN
+      IF (n .le. 0)RETURN
+
+      m = mod(n, 5)
+      IF ( m .ne. 0)THEN
+        IF (alpha .eq. (- one))THEN
+          DO i = 1, m
+            x(i) = - x(i)
+          ENDDO
+        ELSEIF (alpha .eq. zero)THEN
+          DO i = 1, m
+            x(i) = zero
+          ENDDO
+        ELSE
+          DO i = 1, m
+            x(i) = alpha* x(i)
+          ENDDO
+        ENDIF
+        IF ( n .lt. 5)RETURN
+      ENDIF
+      mp1 = m + 1
+      IF (alpha .eq. (- one))THEN
+        DO i = mp1, n, 5
+          x(i)   = - x(i)
+          x(i + 1) = - x(i + 1)
+          x(i + 2) = - x(i + 2)
+          x(i + 3) = - x(i + 3)
+          x(i + 4) = - x(i + 4)
+        ENDDO
+      ELSEIF (alpha .eq. zero)THEN
+        DO i = mp1, n, 5
+          x(i)   = zero
+          x(i + 1) = zero
+          x(i + 2) = zero
+          x(i + 3) = zero
+          x(i + 4) = zero
+        ENDDO
+      ELSE
+        DO i = mp1, n, 5
+          x(i)   = alpha* x(i)
+          x(i + 1) = alpha* x(i + 1)
+          x(i + 2) = alpha* x(i + 2)
+          x(i + 3) = alpha* x(i + 3)
+          x(i + 4) = alpha* x(i + 4)
+        ENDDO
+      ENDIF
+
+      END SUBROUTINE wscal
+ 
+      SUBROUTINE waxpy(n, alpha, x, incx, y, incy)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+!     constant times a vector plus a vector: y <- y + Alpha*x
+!     only for incX=incY=1
+!     after BLAS
+!     replace this by the function from the optimized BLAS implementation:
+!         CALL SAXPY(N,Alpha,X,1,Y,1) or  CALL DAXPY(N,Alpha,X,1,Y,1)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+
+      INTEGER  :: i, incx, incy, m, mp1, n
+      REAL(kind=dp):: x(n), y(n), alpha
+      REAL(kind=dp), PARAMETER :: zero = 0.0_dp
+
+      IF (alpha .eq. zero)RETURN
+      IF (n .le. 0)RETURN
+
+      m = mod(n, 4)
+      IF ( m .ne. 0)THEN
+        DO i = 1, m
+          y(i) = y(i) + alpha* x(i)
+        ENDDO
+        IF ( n .lt. 4)RETURN
+      ENDIF
+      mp1 = m + 1
+      DO i = mp1, n, 4
+        y(i) = y(i) + alpha* x(i)
+        y(i + 1) = y(i + 1) + alpha* x(i + 1)
+        y(i + 2) = y(i + 2) + alpha* x(i + 2)
+        y(i + 3) = y(i + 3) + alpha* x(i + 3)
+      ENDDO
+      
+      END SUBROUTINE waxpy
+ 
+SUBROUTINE rosenbrock(n, y, tstart, tend, &
+           abstol, reltol,             &
+           rcntrl, icntrl, rstatus, istatus, ierr)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!    Solves the system y'=F(t,y) using a Rosenbrock method defined by:
+!
+!     G = 1/(H*gamma(1)) - Jac(t0,Y0)
+!     T_i = t0 + Alpha(i)*H
+!     Y_i = Y0 + \sum_{j=1}^{i-1} A(i,j)*K_j
+!     G *K_i = Fun( T_i,Y_i)+ \sum_{j=1}^S C(i,j)/H *K_j +
+!         gamma(i)*dF/dT(t0,Y0)
+!     Y1 = Y0 + \sum_{j=1}^S M(j)*K_j
+!
+!    For details on Rosenbrock methods and their implementation consult:
+!      E. Hairer and G. Wanner
+!      "Solving ODEs II. Stiff and differential-algebraic problems".
+!      Springer series in computational mathematics,Springer-Verlag,1996.
+!    The codes contained in the book inspired this implementation.
+!
+!    (C)  Adrian Sandu,August 2004
+!    Virginia Polytechnic Institute and State University
+!    Contact: sandu@cs.vt.edu
+!    Revised by Philipp Miehe and Adrian Sandu,May 2006                  
+!    This implementation is part of KPP - the Kinetic PreProcessor
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!~~~>   input arguments:
+!
+!-     y(n)  = vector of initial conditions (at t=tstart)
+!-    [tstart, tend]  = time range of integration
+!     (if Tstart>Tend the integration is performed backwards in time)
+!-    reltol, abstol = user precribed accuracy
+!- SUBROUTINE  fun( t, y, ydot) = ode FUNCTION, 
+!                       returns Ydot = Y' = F(T,Y)
+!- SUBROUTINE  jac( t, y, jcb) = jacobian of the ode FUNCTION, 
+!                       returns Jcb = dFun/dY
+!-    icntrl(1:20)  = INTEGER inputs PARAMETERs
+!-    rcntrl(1:20)  = REAL inputs PARAMETERs
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!~~~>     output arguments:
+!
+!-    y(n)  - > vector of final states (at t- >tend)
+!-    istatus(1:20) - > INTEGER output PARAMETERs
+!-    rstatus(1:20) - > REAL output PARAMETERs
+!-    ierr            - > job status upon RETURN
+!                        success (positive value) or
+!                        failure (negative value)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!~~~>     input PARAMETERs:
+!
+!    Note: For input parameters equal to zero the default values of the
+!       corresponding variables are used.
+!
+!    ICNTRL(1) = 1: F = F(y)   Independent of T (AUTONOMOUS)
+!              = 0: F = F(t,y) Depends on T (NON-AUTONOMOUS)
+!
+!    ICNTRL(2) = 0: AbsTol,RelTol are N-dimensional vectors
+!              = 1: AbsTol,RelTol are scalars
+!
+!    ICNTRL(3)  -> selection of a particular Rosenbrock method
+!        = 0 :    Rodas3 (default)
+!        = 1 :    Ros2
+!        = 2 :    Ros3
+!        = 3 :    Ros4
+!        = 4 :    Rodas3
+!        = 5 :    Rodas4
+!
+!    ICNTRL(4)  -> maximum number of integration steps
+!        For ICNTRL(4) =0) the default value of 100000 is used
+!
+!    RCNTRL(1)  -> Hmin,lower bound for the integration step size
+!          It is strongly recommended to keep Hmin = ZERO
+!    RCNTRL(2)  -> Hmax,upper bound for the integration step size
+!    RCNTRL(3)  -> Hstart,starting value for the integration step size
+!
+!    RCNTRL(4)  -> FacMin,lower bound on step decrease factor (default=0.2)
+!    RCNTRL(5)  -> FacMax,upper bound on step increase factor (default=6)
+!    RCNTRL(6)  -> FacRej,step decrease factor after multiple rejections
+!                          (default=0.1)
+!    RCNTRL(7)  -> FacSafe,by which the new step is slightly smaller
+!         than the predicted value  (default=0.9)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!
+!    OUTPUT ARGUMENTS:
+!    -----------------
+!
+!    T           -> T value for which the solution has been computed
+!                     (after successful return T=Tend).
+!
+!    Y(N)        -> Numerical solution at T
+!
+!    IDID        -> Reports on successfulness upon return:
+!                    = 1 for success
+!                    < 0 for error (value equals error code)
+!
+!    ISTATUS(1)  -> No. of function calls
+!    ISTATUS(2)  -> No. of jacobian calls
+!    ISTATUS(3)  -> No. of steps
+!    ISTATUS(4)  -> No. of accepted steps
+!    ISTATUS(5)  -> No. of rejected steps (except at very beginning)
+!    ISTATUS(6)  -> No. of LU decompositions
+!    ISTATUS(7)  -> No. of forward/backward substitutions
+!    ISTATUS(8)  -> No. of singular matrix decompositions
+!
+!    RSTATUS(1)  -> Texit,the time corresponding to the
+!                     computed Y upon return
+!    RSTATUS(2)  -> Hexit,last accepted step before exit
+!    RSTATUS(3)  -> Hnew,last predicted step (not yet taken)
+!                   For multiple restarts,use Hnew as Hstart 
+!                     in the subsequent run
+!
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~>  arguments
+   INTEGER,      INTENT(IN)  :: n
+   REAL(kind=dp), INTENT(INOUT):: y(n)
+   REAL(kind=dp), INTENT(IN)  :: tstart, tend
+   REAL(kind=dp), INTENT(IN)  :: abstol(n), reltol(n)
+   INTEGER,      INTENT(IN)  :: icntrl(20)
+   REAL(kind=dp), INTENT(IN)  :: rcntrl(20)
+   INTEGER,      INTENT(INOUT):: istatus(20)
+   REAL(kind=dp), INTENT(INOUT):: rstatus(20)
+   INTEGER, INTENT(OUT) :: ierr
+!~~~>  PARAMETERs of the rosenbrock method, up to 6 stages
+   INTEGER ::  ros_s, rosmethod
+   INTEGER, PARAMETER :: rs2=1, rs3=2, rs4=3, rd3=4, rd4=5, rg3=6
+   REAL(kind=dp):: ros_a(15), ros_c(15), ros_m(6), ros_e(6), &
+                    ros_alpha(6), ros_gamma(6), ros_elo
+   LOGICAL :: ros_newf(6)
+   CHARACTER(len=12):: ros_name
+!~~~>  local variables
+   REAL(kind=dp):: roundoff, facmin, facmax, facrej, facsafe
+   REAL(kind=dp):: hmin, hmax, hstart
+   REAL(kind=dp):: texit
+   INTEGER       :: i, uplimtol, max_no_steps
+   LOGICAL       :: autonomous, vectortol
+!~~~>   PARAMETERs
+   REAL(kind=dp), PARAMETER :: zero = 0.0_dp, one  = 1.0_dp
+   REAL(kind=dp), PARAMETER :: deltamin = 1.0e-5_dp
+
+!~~~>  initialize statistics
+   istatus(1:8) = 0
+   rstatus(1:3) = zero
+
+!~~~>  autonomous or time dependent ode. default is time dependent.
+   autonomous = .not.(icntrl(1) == 0)
+
+!~~~>  for scalar tolerances (icntrl(2).ne.0) the code uses abstol(1)and reltol(1)
+!   For Vector tolerances (ICNTRL(2) == 0) the code uses AbsTol(1:N) and RelTol(1:N)
+   IF (icntrl(2) == 0)THEN
+      vectortol = .TRUE.
+      uplimtol  = n
+   ELSE
+      vectortol = .FALSE.
+      uplimtol  = 1
+   ENDIF
+
+!~~~>   initialize the particular rosenbrock method selected
+   select CASE (icntrl(3))
+     CASE (1)
+       CALL ros2
+     CASE (2)
+       CALL ros3
+     CASE (3)
+       CALL ros4
+     CASE (0, 4)
+       CALL rodas3
+     CASE (5)
+       CALL rodas4
+     CASE (6)
+       CALL rang3
+     CASE default
+       PRINT *,'Unknown Rosenbrock method: ICNTRL(3) =',ICNTRL(3) 
+       CALL ros_errormsg(- 2, tstart, zero, ierr)
+       RETURN
+   END select
+
+!~~~>   the maximum number of steps admitted
+   IF (icntrl(4) == 0)THEN
+      max_no_steps = 200000
+   ELSEIF (icntrl(4)> 0)THEN
+      max_no_steps=icntrl(4)
+   ELSE
+      PRINT *,'User-selected max no. of steps: ICNTRL(4) =',ICNTRL(4)
+      CALL ros_errormsg(- 1, tstart, zero, ierr)
+      RETURN
+   ENDIF
+
+!~~~>  unit roundoff (1+ roundoff>1)
+   roundoff = epsilon(one)
+
+!~~~>  lower bound on the step size: (positive value)
+   IF (rcntrl(1) == zero)THEN
+      hmin = zero
+   ELSEIF (rcntrl(1)> zero)THEN
+      hmin = rcntrl(1)
+   ELSE
+      PRINT *,'User-selected Hmin: RCNTRL(1) =',RCNTRL(1)
+      CALL ros_errormsg(- 3, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  upper bound on the step size: (positive value)
+   IF (rcntrl(2) == zero)THEN
+      hmax = abs(tend-tstart)
+   ELSEIF (rcntrl(2)> zero)THEN
+      hmax = min(abs(rcntrl(2)), abs(tend-tstart))
+   ELSE
+      PRINT *,'User-selected Hmax: RCNTRL(2) =',RCNTRL(2)
+      CALL ros_errormsg(- 3, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  starting step size: (positive value)
+   IF (rcntrl(3) == zero)THEN
+      hstart = max(hmin, deltamin)
+   ELSEIF (rcntrl(3)> zero)THEN
+      hstart = min(abs(rcntrl(3)), abs(tend-tstart))
+   ELSE
+      PRINT *,'User-selected Hstart: RCNTRL(3) =',RCNTRL(3)
+      CALL ros_errormsg(- 3, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  step size can be changed s.t.  facmin < hnew/hold < facmax
+   IF (rcntrl(4) == zero)THEN
+      facmin = 0.2_dp
+   ELSEIF (rcntrl(4)> zero)THEN
+      facmin = rcntrl(4)
+   ELSE
+      PRINT *,'User-selected FacMin: RCNTRL(4) =',RCNTRL(4)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+   IF (rcntrl(5) == zero)THEN
+      facmax = 6.0_dp
+   ELSEIF (rcntrl(5)> zero)THEN
+      facmax = rcntrl(5)
+   ELSE
+      PRINT *,'User-selected FacMax: RCNTRL(5) =',RCNTRL(5)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>   facrej: factor to decrease step after 2 succesive rejections
+   IF (rcntrl(6) == zero)THEN
+      facrej = 0.1_dp
+   ELSEIF (rcntrl(6)> zero)THEN
+      facrej = rcntrl(6)
+   ELSE
+      PRINT *,'User-selected FacRej: RCNTRL(6) =',RCNTRL(6)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>   facsafe: safety factor in the computation of new step size
+   IF (rcntrl(7) == zero)THEN
+      facsafe = 0.9_dp
+   ELSEIF (rcntrl(7)> zero)THEN
+      facsafe = rcntrl(7)
+   ELSE
+      PRINT *,'User-selected FacSafe: RCNTRL(7) =',RCNTRL(7)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  check IF tolerances are reasonable
+    DO i=1, uplimtol
+      IF ((abstol(i)<= zero).or. (reltol(i)<= 10.0_dp* roundoff)&
+         .or. (reltol(i)>= 1.0_dp))THEN
+        PRINT *,' AbsTol(',i,') = ',AbsTol(i)
+        PRINT *,' RelTol(',i,') = ',RelTol(i)
+        CALL ros_errormsg(- 5, tstart, zero, ierr)
+        RETURN
+      ENDIF
+    ENDDO
+
+
+!~~~>  CALL rosenbrock method
+   CALL ros_integrator(y, tstart, tend, texit,  &
+        abstol, reltol,                         &
+!  Integration parameters
+        autonomous, vectortol, max_no_steps,    &
+        roundoff, hmin, hmax, hstart,           &
+        facmin, facmax, facrej, facsafe,        &
+!  Error indicator
+        ierr)
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+CONTAINS !  SUBROUTINEs internal to rosenbrock
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
+ SUBROUTINE ros_errormsg(code, t, h, ierr)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
+!    Handles all error messages
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
+  
+   REAL(kind=dp), INTENT(IN):: t, h
+   INTEGER, INTENT(IN) :: code
+   INTEGER, INTENT(OUT):: ierr
+   
+   ierr = code
+   print * , &
+     'Forced exit from Rosenbrock due to the following error:' 
+     
+   select CASE (code)
+    CASE (- 1)  
+      PRINT *,'--> Improper value for maximal no of steps'
+    CASE (- 2)  
+      PRINT *,'--> Selected Rosenbrock method not implemented'
+    CASE (- 3)  
+      PRINT *,'--> Hmin/Hmax/Hstart must be positive'
+    CASE (- 4)  
+      PRINT *,'--> FacMin/FacMax/FacRej must be positive'
+    CASE (- 5)
+      PRINT *,'--> Improper tolerance values'
+    CASE (- 6)
+      PRINT *,'--> No of steps exceeds maximum bound'
+    CASE (- 7)
+      PRINT *,'--> Step size too small: T + 10*H = T',&
+            ' or H < Roundoff'
+    CASE (- 8)  
+      PRINT *,'--> Matrix is repeatedly singular'
+    CASE default
+      PRINT *,'Unknown Error code: ',Code
+   END select
+   
+   print * , "t=", t, "and h=", h
+     
+ END SUBROUTINE ros_errormsg
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ SUBROUTINE ros_integrator (y, tstart, tend, t, &
+        abstol, reltol,                         &
+!~~~> integration PARAMETERs
+        autonomous, vectortol, max_no_steps,    &
+        roundoff, hmin, hmax, hstart,           &
+        facmin, facmax, facrej, facsafe,        &
+!~~~> error indicator
+        ierr)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!   Template for the implementation of a generic Rosenbrock method
+!      defined by ros_S (no of stages)
+!      and its coefficients ros_{A,C,M,E,Alpha,Gamma}
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~> input: the initial condition at tstart; output: the solution at t
+   REAL(kind=dp), INTENT(INOUT):: y(n)
+!~~~> input: integration interval
+   REAL(kind=dp), INTENT(IN):: tstart, tend
+!~~~> output: time at which the solution is RETURNed (t=tendIF success)
+   REAL(kind=dp), INTENT(OUT)::  t
+!~~~> input: tolerances
+   REAL(kind=dp), INTENT(IN)::  abstol(n), reltol(n)
+!~~~> input: integration PARAMETERs
+   LOGICAL, INTENT(IN):: autonomous, vectortol
+   REAL(kind=dp), INTENT(IN):: hstart, hmin, hmax
+   INTEGER, INTENT(IN):: max_no_steps
+   REAL(kind=dp), INTENT(IN):: roundoff, facmin, facmax, facrej, facsafe
+!~~~> output: error indicator
+   INTEGER, INTENT(OUT):: ierr
+! ~~~~ Local variables
+   REAL(kind=dp):: ynew(n), fcn0(n), fcn(n)
+   REAL(kind=dp):: k(n* ros_s), dfdt(n)
+#ifdef full_algebra    
+   REAL(kind=dp):: jac0(n, n), ghimj(n, n)
+#else
+   REAL(kind=dp):: jac0(lu_nonzero), ghimj(lu_nonzero)
+#endif
+   REAL(kind=dp):: h, hnew, hc, hg, fac, tau
+   REAL(kind=dp):: err, yerr(n)
+   INTEGER :: pivot(n), direction, ioffset, j, istage
+   LOGICAL :: rejectlasth, rejectmoreh, singular
+!~~~>  local PARAMETERs
+   REAL(kind=dp), PARAMETER :: zero = 0.0_dp, one  = 1.0_dp
+   REAL(kind=dp), PARAMETER :: deltamin = 1.0e-5_dp
+!~~~>  locally called FUNCTIONs
+!    REAL(kind=dp) WLAMCH
+!    EXTERNAL WLAMCH
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~>  initial preparations
+   t = tstart
+   rstatus(nhexit) = zero
+   h = min( max(abs(hmin), abs(hstart)), abs(hmax))
+   IF (abs(h)<= 10.0_dp* roundoff)h = deltamin
+
+   IF (tend  >=  tstart)THEN
+     direction = + 1
+   ELSE
+     direction = - 1
+   ENDIF
+   h = direction* h
+
+   rejectlasth=.FALSE.
+   rejectmoreh=.FALSE.
+
+!~~~> time loop begins below
+
+timeloop: DO WHILE((direction > 0).and.((t- tend) + roundoff <= zero)&
+       .or. (direction < 0).and.((tend-t) + roundoff <= zero))
+
+   IF (istatus(nstp)> max_no_steps)THEN  ! too many steps
+      CALL ros_errormsg(- 6, t, h, ierr)
+      RETURN
+   ENDIF
+   IF (((t+ 0.1_dp* h) == t).or.(h <= roundoff))THEN  ! step size too small
+      CALL ros_errormsg(- 7, t, h, ierr)
+      RETURN
+   ENDIF
+
+!~~~>  limit h IF necessary to avoid going beyond tend
+   h = min(h, abs(tend-t))
+
+!~~~>   compute the FUNCTION at current time
+   CALL funtemplate(t, y, fcn0)
+   istatus(nfun) = istatus(nfun) + 1
+
+!~~~>  compute the FUNCTION derivative with respect to t
+   IF (.not.autonomous)THEN
+      CALL ros_funtimederivative(t, roundoff, y, &
+                fcn0, dfdt)
+   ENDIF
+
+!~~~>   compute the jacobian at current time
+   CALL jactemplate(t, y, jac0)
+   istatus(njac) = istatus(njac) + 1
+
+!~~~>  repeat step calculation until current step accepted
+untilaccepted: do
+
+   CALL ros_preparematrix(h, direction, ros_gamma(1), &
+          jac0, ghimj, pivot, singular)
+   IF (singular)THEN ! more than 5 consecutive failed decompositions
+       CALL ros_errormsg(- 8, t, h, ierr)
+       RETURN
+   ENDIF
+
+!~~~>   compute the stages
+stage: DO istage = 1, ros_s
+
+      ! current istage offset. current istage vector is k(ioffset+ 1:ioffset+ n)
+       ioffset = n* (istage-1)
+
+      ! for the 1st istage the FUNCTION has been computed previously
+       IF (istage == 1)THEN
+         !slim: CALL wcopy(n, fcn0, 1, fcn, 1)
+       fcn(1:n) = fcn0(1:n)
+      ! istage>1 and a new FUNCTION evaluation is needed at the current istage
+       ELSEIF(ros_newf(istage))THEN
+         !slim: CALL wcopy(n, y, 1, ynew, 1)
+       ynew(1:n) = y(1:n)
+         DO j = 1, istage-1
+           CALL waxpy(n, ros_a((istage-1) * (istage-2) /2+ j), &
+            k(n* (j- 1) + 1), 1, ynew, 1)
+         ENDDO
+         tau = t + ros_alpha(istage) * direction* h
+         CALL funtemplate(tau, ynew, fcn)
+         istatus(nfun) = istatus(nfun) + 1
+       ENDIF ! IF istage == 1 ELSEIF ros_newf(istage)
+       !slim: CALL wcopy(n, fcn, 1, k(ioffset+ 1), 1)
+       k(ioffset+ 1:ioffset+ n) = fcn(1:n)
+       DO j = 1, istage-1
+         hc = ros_c((istage-1) * (istage-2) /2+ j) /(direction* h)
+         CALL waxpy(n, hc, k(n* (j- 1) + 1), 1, k(ioffset+ 1), 1)
+       ENDDO
+       IF ((.not. autonomous).and.(ros_gamma(istage).ne.zero))THEN
+         hg = direction* h* ros_gamma(istage)
+         CALL waxpy(n, hg, dfdt, 1, k(ioffset+ 1), 1)
+       ENDIF
+       CALL ros_solve(ghimj, pivot, k(ioffset+ 1))
+
+   END DO stage
+
+
+!~~~>  compute the new solution
+   !slim: CALL wcopy(n, y, 1, ynew, 1)
+   ynew(1:n) = y(1:n)
+   DO j=1, ros_s
+         CALL waxpy(n, ros_m(j), k(n* (j- 1) + 1), 1, ynew, 1)
+   ENDDO
+
+!~~~>  compute the error estimation
+   !slim: CALL wscal(n, zero, yerr, 1)
+   yerr(1:n) = zero
+   DO j=1, ros_s
+        CALL waxpy(n, ros_e(j), k(n* (j- 1) + 1), 1, yerr, 1)
+   ENDDO
+   err = ros_errornorm(y, ynew, yerr, abstol, reltol, vectortol)
+
+!~~~> new step size is bounded by facmin <= hnew/h <= facmax
+   fac  = min(facmax, max(facmin, facsafe/err** (one/ros_elo)))
+   hnew = h* fac
+
+!~~~>  check the error magnitude and adjust step size
+   istatus(nstp) = istatus(nstp) + 1
+   IF ((err <= one).or.(h <= hmin))THEN  !~~~> accept step
+      istatus(nacc) = istatus(nacc) + 1
+      !slim: CALL wcopy(n, ynew, 1, y, 1)
+      y(1:n) = ynew(1:n)
+      t = t + direction* h
+      hnew = max(hmin, min(hnew, hmax))
+      IF (rejectlasth)THEN  ! no step size increase after a rejected step
+         hnew = min(hnew, h)
+      ENDIF
+      rstatus(nhexit) = h
+      rstatus(nhnew) = hnew
+      rstatus(ntexit) = t
+      rejectlasth = .FALSE.
+      rejectmoreh = .FALSE.
+      h = hnew
+      exit untilaccepted ! exit the loop: WHILE step not accepted
+   ELSE           !~~~> reject step
+      IF (rejectmoreh)THEN
+         hnew = h* facrej
+      ENDIF
+      rejectmoreh = rejectlasth
+      rejectlasth = .TRUE.
+      h = hnew
+      IF (istatus(nacc)>= 1) istatus(nrej) = istatus(nrej) + 1
+   ENDIF ! err <= 1
+
+   END DO untilaccepted
+
+   END DO timeloop
+
+!~~~> succesful exit
+   ierr = 1  !~~~> the integration was successful
+
+  END SUBROUTINE ros_integrator
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  REAL(kind=dp)FUNCTION ros_errornorm(y, ynew, yerr, &
+                               abstol, reltol, vectortol)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> computes the "scaled norm" of the error vector yerr
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+! Input arguments
+   REAL(kind=dp), INTENT(IN):: y(n), ynew(n), &
+          yerr(n), abstol(n), reltol(n)
+   LOGICAL, INTENT(IN)::  vectortol
+! Local variables
+   REAL(kind=dp):: err, scale, ymax
+   INTEGER  :: i
+   REAL(kind=dp), PARAMETER :: zero = 0.0_dp
+
+   err = zero
+   DO i=1, n
+     ymax = max(abs(y(i)), abs(ynew(i)))
+     IF (vectortol)THEN
+       scale = abstol(i) + reltol(i) * ymax
+     ELSE
+       scale = abstol(1) + reltol(1) * ymax
+     ENDIF
+     err = err+ (yerr(i) /scale) ** 2
+   ENDDO
+   err  = sqrt(err/n)
+
+   ros_errornorm = max(err, 1.0d-10)
+
+  END FUNCTION ros_errornorm
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_funtimederivative(t, roundoff, y, &
+                fcn0, dfdt)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> the time partial derivative of the FUNCTION by finite differences
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+!~~~> input arguments
+   REAL(kind=dp), INTENT(IN):: t, roundoff, y(n), fcn0(n)
+!~~~> output arguments
+   REAL(kind=dp), INTENT(OUT):: dfdt(n)
+!~~~> local variables
+   REAL(kind=dp):: delta
+   REAL(kind=dp), PARAMETER :: one = 1.0_dp, deltamin = 1.0e-6_dp
+
+   delta = sqrt(roundoff) * max(deltamin, abs(t))
+   CALL funtemplate(t+ delta, y, dfdt)
+   istatus(nfun) = istatus(nfun) + 1
+   CALL waxpy(n, (- one), fcn0, 1, dfdt, 1)
+   CALL wscal(n, (one/delta), dfdt, 1)
+
+  END SUBROUTINE ros_funtimederivative
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_preparematrix(h, direction, gam, &
+             jac0, ghimj, pivot, singular)
+! --- --- --- --- --- --- --- --- --- --- --- --- ---
+!  Prepares the LHS matrix for stage calculations
+!  1.  Construct Ghimj = 1/(H*ham) - Jac0
+!      "(Gamma H) Inverse Minus Jacobian"
+!  2.  Repeat LU decomposition of Ghimj until successful.
+!       -half the step size if LU decomposition fails and retry
+!       -exit after 5 consecutive fails
+! --- --- --- --- --- --- --- --- --- --- --- --- ---
+
+!~~~> input arguments
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(IN)::  jac0(n, n)
+#else
+   REAL(kind=dp), INTENT(IN)::  jac0(lu_nonzero)
+#endif   
+   REAL(kind=dp), INTENT(IN)::  gam
+   INTEGER, INTENT(IN)::  direction
+!~~~> output arguments
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(OUT):: ghimj(n, n)
+#else
+   REAL(kind=dp), INTENT(OUT):: ghimj(lu_nonzero)
+#endif   
+   LOGICAL, INTENT(OUT)::  singular
+   INTEGER, INTENT(OUT)::  pivot(n)
+!~~~> inout arguments
+   REAL(kind=dp), INTENT(INOUT):: h   ! step size is decreased when lu fails
+!~~~> local variables
+   INTEGER  :: i, ising, nconsecutive
+   REAL(kind=dp):: ghinv
+   REAL(kind=dp), PARAMETER :: one  = 1.0_dp, half = 0.5_dp
+
+   nconsecutive = 0
+   singular = .TRUE.
+
+   DO WHILE (singular)
+
+!~~~>    construct ghimj = 1/(h* gam) - jac0
+#ifdef full_algebra    
+     !slim: CALL wcopy(n* n, jac0, 1, ghimj, 1)
+     !slim: CALL wscal(n* n, (- one), ghimj, 1)
+     ghimj = - jac0
+     ghinv = one/(direction* h* gam)
+     DO i=1, n
+       ghimj(i, i) = ghimj(i, i) + ghinv
+     ENDDO
+#else
+     !slim: CALL wcopy(lu_nonzero, jac0, 1, ghimj, 1)
+     !slim: CALL wscal(lu_nonzero, (- one), ghimj, 1)
+     ghimj(1:lu_nonzero) = - jac0(1:lu_nonzero)
+     ghinv = one/(direction* h* gam)
+     DO i=1, n
+       ghimj(lu_diag(i)) = ghimj(lu_diag(i)) + ghinv
+     ENDDO
+#endif   
+!~~~>    compute lu decomposition
+     CALL ros_decomp( ghimj, pivot, ising)
+     IF (ising == 0)THEN
+!~~~>    IF successful done
+        singular = .FALSE.
+     ELSE ! ising .ne. 0
+!~~~>    IF unsuccessful half the step size; IF 5 consecutive fails THEN RETURN
+        istatus(nsng) = istatus(nsng) + 1
+        nconsecutive = nconsecutive+1
+        singular = .TRUE.
+        PRINT*,'Warning: LU Decomposition returned ISING = ',ISING
+        IF (nconsecutive <= 5)THEN ! less than 5 consecutive failed decompositions
+           h = h* half
+        ELSE  ! more than 5 consecutive failed decompositions
+           RETURN
+        ENDIF  ! nconsecutive
+      ENDIF    ! ising
+
+   END DO ! WHILE singular
+
+  END SUBROUTINE ros_preparematrix
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_decomp( a, pivot, ising)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the LU decomposition
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> inout variables
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(INOUT):: a(n, n)
+#else   
+   REAL(kind=dp), INTENT(INOUT):: a(lu_nonzero)
+#endif
+!~~~> output variables
+   INTEGER, INTENT(OUT):: pivot(n), ising
+
+#ifdef full_algebra    
+   CALL  dgetrf( n, n, a, n, pivot, ising)
+#else   
+   CALL kppdecomp(a, ising)
+   pivot(1) = 1
+#endif
+   istatus(ndec) = istatus(ndec) + 1
+
+  END SUBROUTINE ros_decomp
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_solve( a, pivot, b)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the forward/backward substitution (using pre-computed LU decomposition)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> input variables
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(IN):: a(n, n)
+   INTEGER :: ising
+#else   
+   REAL(kind=dp), INTENT(IN):: a(lu_nonzero)
+#endif
+   INTEGER, INTENT(IN):: pivot(n)
+!~~~> inout variables
+   REAL(kind=dp), INTENT(INOUT):: b(n)
+
+#ifdef full_algebra    
+   CALL  DGETRS( 'N',N ,1,A,N,Pivot,b,N,ISING)
+   IF (info < 0)THEN
+      print* , "error in dgetrs. ising=", ising
+   ENDIF  
+#else   
+   CALL kppsolve( a, b)
+#endif
+
+   istatus(nsol) = istatus(nsol) + 1
+
+  END SUBROUTINE ros_solve
+
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros2
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! --- AN L-STABLE METHOD,2 stages,order 2
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+   double precision g
+
+    g = 1.0_dp + 1.0_dp/sqrt(2.0_dp)
+    rosmethod = rs2
+!~~~> name of the method
+    ros_Name = 'ROS-2'
+!~~~> number of stages
+    ros_s = 2
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+    ros_a(1) = (1.0_dp) /g
+    ros_c(1) = (- 2.0_dp) /g
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+    ros_newf(1) = .TRUE.
+    ros_newf(2) = .TRUE.
+!~~~> m_i = coefficients for new step solution
+    ros_m(1) = (3.0_dp) /(2.0_dp* g)
+    ros_m(2) = (1.0_dp) /(2.0_dp* g)
+! E_i = Coefficients for error estimator
+    ros_e(1) = 1.0_dp/(2.0_dp* g)
+    ros_e(2) = 1.0_dp/(2.0_dp* g)
+!~~~> ros_elo = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus one
+    ros_elo = 2.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+    ros_alpha(1) = 0.0_dp
+    ros_alpha(2) = 1.0_dp
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+    ros_gamma(1) = g
+    ros_gamma(2) = -g
+
+ END SUBROUTINE ros2
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! --- AN L-STABLE METHOD,3 stages,order 3,2 function evaluations
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+   rosmethod = rs3
+!~~~> name of the method
+   ros_Name = 'ROS-3'
+!~~~> number of stages
+   ros_s = 3
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+   ros_a(1) = 1.0_dp
+   ros_a(2) = 1.0_dp
+   ros_a(3) = 0.0_dp
+
+   ros_c(1) = - 0.10156171083877702091975600115545e+01_dp
+   ros_c(2) =  0.40759956452537699824805835358067e+01_dp
+   ros_c(3) =  0.92076794298330791242156818474003e+01_dp
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+   ros_newf(1) = .TRUE.
+   ros_newf(2) = .TRUE.
+   ros_newf(3) = .FALSE.
+!~~~> m_i = coefficients for new step solution
+   ros_m(1) =  0.1e+01_dp
+   ros_m(2) =  0.61697947043828245592553615689730e+01_dp
+   ros_m(3) = - 0.42772256543218573326238373806514_dp
+! E_i = Coefficients for error estimator
+   ros_e(1) =  0.5_dp
+   ros_e(2) = - 0.29079558716805469821718236208017e+01_dp
+   ros_e(3) =  0.22354069897811569627360909276199_dp
+!~~~> ros_elo = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus 1
+   ros_elo = 3.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+   ros_alpha(1) = 0.0_dp
+   ros_alpha(2) = 0.43586652150845899941601945119356_dp
+   ros_alpha(3) = 0.43586652150845899941601945119356_dp
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+   ros_gamma(1) = 0.43586652150845899941601945119356_dp
+   ros_gamma(2) = 0.24291996454816804366592249683314_dp
+   ros_gamma(3) = 0.21851380027664058511513169485832e+01_dp
+
+  END SUBROUTINE ros3
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros4
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     L-STABLE ROSENBROCK METHOD OF ORDER 4,WITH 4 STAGES
+!     L-STABLE EMBEDDED ROSENBROCK METHOD OF ORDER 3
+!
+!      E. HAIRER AND G. WANNER,SOLVING ORDINARY DIFFERENTIAL
+!      EQUATIONS II. STIFF AND DIFFERENTIAL-ALGEBRAIC PROBLEMS.
+!      SPRINGER SERIES IN COMPUTATIONAL MATHEMATICS,
+!      SPRINGER-VERLAG (1990)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+   rosmethod = rs4
+!~~~> name of the method
+   ros_Name = 'ROS-4'
+!~~~> number of stages
+   ros_s = 4
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+   ros_a(1) = 0.2000000000000000e+01_dp
+   ros_a(2) = 0.1867943637803922e+01_dp
+   ros_a(3) = 0.2344449711399156_dp
+   ros_a(4) = ros_a(2)
+   ros_a(5) = ros_a(3)
+   ros_a(6) = 0.0_dp
+
+   ros_c(1) = -0.7137615036412310e+01_dp
+   ros_c(2) = 0.2580708087951457e+01_dp
+   ros_c(3) = 0.6515950076447975_dp
+   ros_c(4) = -0.2137148994382534e+01_dp
+   ros_c(5) = -0.3214669691237626_dp
+   ros_c(6) = -0.6949742501781779_dp
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+   ros_newf(1) = .TRUE.
+   ros_newf(2) = .TRUE.
+   ros_newf(3) = .TRUE.
+   ros_newf(4) = .FALSE.
+!~~~> m_i = coefficients for new step solution
+   ros_m(1) = 0.2255570073418735e+01_dp
+   ros_m(2) = 0.2870493262186792_dp
+   ros_m(3) = 0.4353179431840180_dp
+   ros_m(4) = 0.1093502252409163e+01_dp
+!~~~> e_i  = coefficients for error estimator
+   ros_e(1) = -0.2815431932141155_dp
+   ros_e(2) = -0.7276199124938920e-01_dp
+   ros_e(3) = -0.1082196201495311_dp
+   ros_e(4) = -0.1093502252409163e+01_dp
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus 1
+   ros_elo  = 4.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+   ros_alpha(1) = 0.0_dp
+   ros_alpha(2) = 0.1145640000000000e+01_dp
+   ros_alpha(3) = 0.6552168638155900_dp
+   ros_alpha(4) = ros_alpha(3)
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+   ros_gamma(1) = 0.5728200000000000_dp
+   ros_gamma(2) = -0.1769193891319233e+01_dp
+   ros_gamma(3) = 0.7592633437920482_dp
+   ros_gamma(4) = -0.1049021087100450_dp
+
+  END SUBROUTINE ros4
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE rodas3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! --- A STIFFLY-STABLE METHOD,4 stages,order 3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+   rosmethod = rd3
+!~~~> name of the method
+   ros_Name = 'RODAS-3'
+!~~~> number of stages
+   ros_s = 4
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+   ros_a(1) = 0.0_dp
+   ros_a(2) = 2.0_dp
+   ros_a(3) = 0.0_dp
+   ros_a(4) = 2.0_dp
+   ros_a(5) = 0.0_dp
+   ros_a(6) = 1.0_dp
+
+   ros_c(1) = 4.0_dp
+   ros_c(2) = 1.0_dp
+   ros_c(3) = -1.0_dp
+   ros_c(4) = 1.0_dp
+   ros_c(5) = -1.0_dp
+   ros_c(6) = -(8.0_dp/3.0_dp)
+
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+   ros_newf(1) = .TRUE.
+   ros_newf(2) = .FALSE.
+   ros_newf(3) = .TRUE.
+   ros_newf(4) = .TRUE.
+!~~~> m_i = coefficients for new step solution
+   ros_m(1) = 2.0_dp
+   ros_m(2) = 0.0_dp
+   ros_m(3) = 1.0_dp
+   ros_m(4) = 1.0_dp
+!~~~> e_i  = coefficients for error estimator
+   ros_e(1) = 0.0_dp
+   ros_e(2) = 0.0_dp
+   ros_e(3) = 0.0_dp
+   ros_e(4) = 1.0_dp
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus 1
+   ros_elo  = 3.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+   ros_alpha(1) = 0.0_dp
+   ros_alpha(2) = 0.0_dp
+   ros_alpha(3) = 1.0_dp
+   ros_alpha(4) = 1.0_dp
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+   ros_gamma(1) = 0.5_dp
+   ros_gamma(2) = 1.5_dp
+   ros_gamma(3) = 0.0_dp
+   ros_gamma(4) = 0.0_dp
+
+  END SUBROUTINE rodas3
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE rodas4
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     STIFFLY-STABLE ROSENBROCK METHOD OF ORDER 4,WITH 6 STAGES
+!
+!      E. HAIRER AND G. WANNER,SOLVING ORDINARY DIFFERENTIAL
+!      EQUATIONS II. STIFF AND DIFFERENTIAL-ALGEBRAIC PROBLEMS.
+!      SPRINGER SERIES IN COMPUTATIONAL MATHEMATICS,
+!      SPRINGER-VERLAG (1996)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+    rosmethod = rd4
+!~~~> name of the method
+    ros_Name = 'RODAS-4'
+!~~~> number of stages
+    ros_s = 6
+
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+    ros_alpha(1) = 0.000_dp
+    ros_alpha(2) = 0.386_dp
+    ros_alpha(3) = 0.210_dp
+    ros_alpha(4) = 0.630_dp
+    ros_alpha(5) = 1.000_dp
+    ros_alpha(6) = 1.000_dp
+
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+    ros_gamma(1) = 0.2500000000000000_dp
+    ros_gamma(2) = -0.1043000000000000_dp
+    ros_gamma(3) = 0.1035000000000000_dp
+    ros_gamma(4) = -0.3620000000000023e-01_dp
+    ros_gamma(5) = 0.0_dp
+    ros_gamma(6) = 0.0_dp
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:  A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!                  C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+    ros_a(1) = 0.1544000000000000e+01_dp
+    ros_a(2) = 0.9466785280815826_dp
+    ros_a(3) = 0.2557011698983284_dp
+    ros_a(4) = 0.3314825187068521e+01_dp
+    ros_a(5) = 0.2896124015972201e+01_dp
+    ros_a(6) = 0.9986419139977817_dp
+    ros_a(7) = 0.1221224509226641e+01_dp
+    ros_a(8) = 0.6019134481288629e+01_dp
+    ros_a(9) = 0.1253708332932087e+02_dp
+    ros_a(10) = -0.6878860361058950_dp
+    ros_a(11) = ros_a(7)
+    ros_a(12) = ros_a(8)
+    ros_a(13) = ros_a(9)
+    ros_a(14) = ros_a(10)
+    ros_a(15) = 1.0_dp
+
+    ros_c(1) = -0.5668800000000000e+01_dp
+    ros_c(2) = -0.2430093356833875e+01_dp
+    ros_c(3) = -0.2063599157091915_dp
+    ros_c(4) = -0.1073529058151375_dp
+    ros_c(5) = -0.9594562251023355e+01_dp
+    ros_c(6) = -0.2047028614809616e+02_dp
+    ros_c(7) = 0.7496443313967647e+01_dp
+    ros_c(8) = -0.1024680431464352e+02_dp
+    ros_c(9) = -0.3399990352819905e+02_dp
+    ros_c(10) = 0.1170890893206160e+02_dp
+    ros_c(11) = 0.8083246795921522e+01_dp
+    ros_c(12) = -0.7981132988064893e+01_dp
+    ros_c(13) = -0.3152159432874371e+02_dp
+    ros_c(14) = 0.1631930543123136e+02_dp
+    ros_c(15) = -0.6058818238834054e+01_dp
+
+!~~~> m_i = coefficients for new step solution
+    ros_m(1) = ros_a(7)
+    ros_m(2) = ros_a(8)
+    ros_m(3) = ros_a(9)
+    ros_m(4) = ros_a(10)
+    ros_m(5) = 1.0_dp
+    ros_m(6) = 1.0_dp
+
+!~~~> e_i  = coefficients for error estimator
+    ros_e(1) = 0.0_dp
+    ros_e(2) = 0.0_dp
+    ros_e(3) = 0.0_dp
+    ros_e(4) = 0.0_dp
+    ros_e(5) = 0.0_dp
+    ros_e(6) = 1.0_dp
+
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+    ros_newf(1) = .TRUE.
+    ros_newf(2) = .TRUE.
+    ros_newf(3) = .TRUE.
+    ros_newf(4) = .TRUE.
+    ros_newf(5) = .TRUE.
+    ros_newf(6) = .TRUE.
+
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!        main and the embedded scheme orders plus 1
+    ros_elo = 4.0_dp
+
+  END SUBROUTINE rodas4
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE rang3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! STIFFLY-STABLE W METHOD OF ORDER 3,WITH 4 STAGES
+!
+! J. RANG and L. ANGERMANN
+! NEW ROSENBROCK W-METHODS OF ORDER 3
+! FOR PARTIAL DIFFERENTIAL ALGEBRAIC
+!        EQUATIONS OF INDEX 1                                             
+! BIT Numerical Mathematics (2005) 45: 761-787
+!  DOI: 10.1007/s10543-005-0035-y
+! Table 4.1-4.2
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+    rosmethod = rg3
+!~~~> name of the method
+    ros_Name = 'RANG-3'
+!~~~> number of stages
+    ros_s = 4
+
+    ros_a(1) = 5.09052051067020d+00;
+    ros_a(2) = 5.09052051067020d+00;
+    ros_a(3) = 0.0d0;
+    ros_a(4) = 4.97628111010787d+00;
+    ros_a(5) = 2.77268164715849d-02;
+    ros_a(6) = 2.29428036027904d-01;
+
+    ros_c(1) = - 1.16790812312283d+01;
+    ros_c(2) = - 1.64057326467367d+01;
+    ros_c(3) = - 2.77268164715850d-01;
+    ros_c(4) = - 8.38103960500476d+00;
+    ros_c(5) = - 8.48328409199343d-01;
+    ros_c(6) =  2.87009860433106d-01;
+
+    ros_m(1) =  5.22582761233094d+00;
+    ros_m(2) = - 5.56971148154165d-01;
+    ros_m(3) =  3.57979469353645d-01;
+    ros_m(4) =  1.72337398521064d+00;
+
+    ros_e(1) = - 5.16845212784040d+00;
+    ros_e(2) = - 1.26351942603842d+00;
+    ros_e(3) = - 1.11022302462516d-16;
+    ros_e(4) =  2.22044604925031d-16;
+
+    ros_alpha(1) = 0.0d00;
+    ros_alpha(2) = 2.21878746765329d+00;
+    ros_alpha(3) = 2.21878746765329d+00;
+    ros_alpha(4) = 1.55392337535788d+00;
+
+    ros_gamma(1) =  4.35866521508459d-01;
+    ros_gamma(2) = - 1.78292094614483d+00;
+    ros_gamma(3) = - 2.46541900496934d+00;
+    ros_gamma(4) = - 8.05529997906370d-01;
+
+
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+    ros_newf(1) = .TRUE.
+    ros_newf(2) = .TRUE.
+    ros_newf(3) = .TRUE.
+    ros_newf(4) = .TRUE.
+
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!        main and the embedded scheme orders plus 1
+    ros_elo = 3.0_dp
+
+  END SUBROUTINE rang3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!   End of the set of internal Rosenbrock subroutines
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END SUBROUTINE rosenbrock
+ 
+SUBROUTINE funtemplate( t, y, ydot)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the ODE function call.
+!  Updates the rate coefficients (and possibly the fixed species) at each call
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> input variables
+   REAL(kind=dp):: t, y(nvar)
+!~~~> output variables
+   REAL(kind=dp):: ydot(nvar)
+!~~~> local variables
+   REAL(kind=dp):: told
+
+   told = time
+   time = t
+   CALL fun( y, fix, rconst, ydot)
+   time = told
+
+END SUBROUTINE funtemplate
+ 
+SUBROUTINE jactemplate( t, y, jcb)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the ODE Jacobian call.
+!  Updates the rate coefficients (and possibly the fixed species) at each call
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> input variables
+    REAL(kind=dp):: t, y(nvar)
+!~~~> output variables
+#ifdef full_algebra    
+    REAL(kind=dp):: jv(lu_nonzero), jcb(nvar, nvar)
+#else
+    REAL(kind=dp):: jcb(lu_nonzero)
+#endif   
+!~~~> local variables
+    REAL(kind=dp):: told
+#ifdef full_algebra    
+    INTEGER :: i, j
+#endif   
+
+    told = time
+    time = t
+#ifdef full_algebra    
+    CALL jac_sp(y, fix, rconst, jv)
+    DO j=1, nvar
+      DO i=1, nvar
+         jcb(i, j) = 0.0_dp
+      ENDDO
+    ENDDO
+    DO i=1, lu_nonzero
+       jcb(lu_irow(i), lu_icol(i)) = jv(i)
+    ENDDO
+#else
+    CALL jac_sp( y, fix, rconst, jcb)
+#endif   
+    time = told
+
+END SUBROUTINE jactemplate
+ 
+  SUBROUTINE kppdecomp( jvs, ier)                                    
+  ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
+  !        sparse lu factorization                                    
+  ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
+  ! loop expansion generated by kp4                                   
+                                                                      
+    INTEGER  :: ier                                                   
+    REAL(kind=dp):: jvs(lu_nonzero), w(nvar), a             
+    INTEGER  :: k, kk, j, jj                                          
+                                                                      
+    a = 0.                                                            
+    ier = 0                                                           
+                                                                      
+!   i = 1
+!   i = 2
+!   i = 3
+!   i = 4
+!   i = 5
+!   i = 6
+!   i = 7
+!   i = 8
+!   i = 9
+!   i = 10
+!   i = 11
+    jvs(38) = (jvs(38)) / jvs(14) 
+    jvs(39) = (jvs(39)) / jvs(19) 
+    jvs(41) = jvs(41) - jvs(15) * jvs(38) - jvs(20) * jvs(39)
+!   i = 12
+    jvs(43) = (jvs(43)) / jvs(16) 
+    jvs(48) = jvs(48) - jvs(17) * jvs(43)
+    jvs(50) = jvs(50) - jvs(18) * jvs(43)
+!   i = 13
+!   i = 14
+    jvs(55) = (jvs(55)) / jvs(14) 
+    jvs(56) = (jvs(56)) / jvs(19) 
+    jvs(57) = (jvs(57)) / jvs(40) 
+    jvs(59) = jvs(59) - jvs(15) * jvs(55) - jvs(20) * jvs(56) - jvs(41) * jvs(57)
+    jvs(61) = jvs(61) - jvs(42) * jvs(57)
+!   i = 15
+    jvs(62) = (jvs(62)) / jvs(19) 
+    jvs(67) = jvs(67) - jvs(20) * jvs(62)
+!   i = 16
+    jvs(68) = (jvs(68)) / jvs(63) 
+    jvs(71) = jvs(71) - jvs(64) * jvs(68)
+    jvs(73) = jvs(73) - jvs(65) * jvs(68)
+    jvs(76) = jvs(76) - jvs(66) * jvs(68)
+    jvs(77) = jvs(77) - jvs(67) * jvs(68)
+!   i = 17
+!   i = 18
+    jvs(85) = (jvs(85)) / jvs(14) 
+    jvs(86) = (jvs(86)) / jvs(19) 
+    jvs(87) = (jvs(87)) / jvs(51) 
+    jvs(88) = (jvs(88)) / jvs(58) 
+    jvs(89) = (jvs(89)) / jvs(63) 
+    jvs(90) = (jvs(90)) / jvs(80) 
+    jvs(92) = jvs(92) - jvs(64) * jvs(89)
+    jvs(93) = jvs(93) - jvs(52) * jvs(87)
+    jvs(94) = jvs(94) - jvs(65) * jvs(89) - jvs(81) * jvs(90)
+    jvs(97) = jvs(97) - jvs(66) * jvs(89) - jvs(82) * jvs(90)
+    jvs(98) = jvs(98) - jvs(53) * jvs(87)
+    jvs(99) = jvs(99) - jvs(15) * jvs(85) - jvs(20) * jvs(86) - jvs(54) * jvs(87) - jvs(59) * jvs(88)&
+          - jvs(67) * jvs(89) - jvs(83) * jvs(90)
+    jvs(101) = jvs(101) - jvs(84) * jvs(90)
+    jvs(102) = jvs(102) - jvs(60) * jvs(88)
+    jvs(103) = jvs(103) - jvs(61) * jvs(88)
+!   i = 19
+    jvs(105) = (jvs(105)) / jvs(40) 
+    jvs(106) = (jvs(106)) / jvs(58) 
+    jvs(109) = jvs(109) - jvs(41) * jvs(105) - jvs(59) * jvs(106)
+    jvs(110) = jvs(110) - jvs(60) * jvs(106)
+    jvs(111) = jvs(111) - jvs(42) * jvs(105) - jvs(61) * jvs(106)
+!   i = 20
+    jvs(112) = (jvs(112)) / jvs(19) 
+    jvs(113) = (jvs(113)) / jvs(51) 
+    jvs(114) = jvs(114) - jvs(52) * jvs(113)
+    jvs(118) = jvs(118) - jvs(53) * jvs(113)
+    jvs(119) = jvs(119) - jvs(20) * jvs(112) - jvs(54) * jvs(113)
+!   i = 21
+    jvs(122) = (jvs(122)) / jvs(80) 
+    jvs(123) = (jvs(123)) / jvs(107) 
+    jvs(125) = jvs(125) - jvs(81) * jvs(122)
+    jvs(128) = jvs(128) - jvs(82) * jvs(122) - jvs(108) * jvs(123)
+    jvs(129) = jvs(129) - jvs(83) * jvs(122) - jvs(109) * jvs(123)
+    jvs(131) = jvs(131) - jvs(84) * jvs(122)
+    jvs(132) = jvs(132) - jvs(110) * jvs(123)
+    jvs(133) = jvs(133) - jvs(111) * jvs(123)
+!   i = 22
+!   i = 23
+    jvs(140) = (jvs(140)) / jvs(135) 
+    jvs(142) = jvs(142) - jvs(136) * jvs(140)
+    jvs(143) = jvs(143) - jvs(137) * jvs(140)
+    jvs(144) = jvs(144) - jvs(138) * jvs(140)
+    jvs(145) = jvs(145) - jvs(139) * jvs(140)
+!   i = 24
+    jvs(146) = (jvs(146)) / jvs(51) 
+    jvs(147) = (jvs(147)) / jvs(80) 
+    jvs(148) = (jvs(148)) / jvs(107) 
+    a = 0.0; a = a  - jvs(52) * jvs(146)
+    jvs(149) = (jvs(149) + a) / jvs(114) 
+    a = 0.0; a = a  - jvs(81) * jvs(147) - jvs(115) * jvs(149)
+    jvs(150) = (jvs(150) + a) / jvs(135) 
+    a = 0.0; a = a  - jvs(116) * jvs(149)
+    jvs(151) = (jvs(151) + a) / jvs(141) 
+    jvs(153) = jvs(153) - jvs(82) * jvs(147) - jvs(108) * jvs(148) - jvs(117) * jvs(149) - jvs(136) * jvs(150)&
+          - jvs(142) * jvs(151)
+    jvs(154) = jvs(154) - jvs(53) * jvs(146) - jvs(118) * jvs(149)
+    jvs(155) = jvs(155) - jvs(54) * jvs(146) - jvs(83) * jvs(147) - jvs(109) * jvs(148) - jvs(119) * jvs(149)&
+          - jvs(137) * jvs(150) - jvs(143) * jvs(151)
+    jvs(156) = jvs(156) - jvs(84) * jvs(147) - jvs(120) * jvs(149) - jvs(138) * jvs(150) - jvs(144) * jvs(151)
+    jvs(157) = jvs(157) - jvs(110) * jvs(148) - jvs(121) * jvs(149) - jvs(139) * jvs(150) - jvs(145) * jvs(151)
+    jvs(158) = jvs(158) - jvs(111) * jvs(148)
+!   i = 25
+    jvs(159) = (jvs(159)) / jvs(80) 
+    jvs(160) = (jvs(160)) / jvs(107) 
+    a = 0.0; a = a  - jvs(81) * jvs(159)
+    jvs(161) = (jvs(161) + a) / jvs(135) 
+    jvs(162) = (jvs(162)) / jvs(141) 
+    jvs(163) = jvs(163) - jvs(82) * jvs(159) - jvs(108) * jvs(160) - jvs(136) * jvs(161) - jvs(142) * jvs(162)
+    jvs(165) = jvs(165) - jvs(83) * jvs(159) - jvs(109) * jvs(160) - jvs(137) * jvs(161) - jvs(143) * jvs(162)
+    jvs(167) = jvs(167) - jvs(84) * jvs(159) - jvs(138) * jvs(161) - jvs(144) * jvs(162)
+    jvs(168) = jvs(168) - jvs(110) * jvs(160) - jvs(139) * jvs(161) - jvs(145) * jvs(162)
+    jvs(169) = jvs(169) - jvs(111) * jvs(160)
+!   i = 26
+    jvs(170) = (jvs(170)) / jvs(6) 
+    jvs(171) = (jvs(171)) / jvs(9) 
+    jvs(172) = (jvs(172)) / jvs(16) 
+    jvs(173) = (jvs(173)) / jvs(30) 
+    jvs(174) = (jvs(174)) / jvs(34) 
+    jvs(175) = (jvs(175)) / jvs(40) 
+    jvs(176) = (jvs(176)) / jvs(51) 
+    a = 0.0; a = a  - jvs(10) * jvs(171)
+    jvs(177) = (jvs(177) + a) / jvs(58) 
+    jvs(178) = (jvs(178)) / jvs(91) 
+    a = 0.0; a = a  - jvs(92) * jvs(178)
+    jvs(179) = (jvs(179) + a) / jvs(107) 
+    a = 0.0; a = a  - jvs(52) * jvs(176) - jvs(93) * jvs(178)
+    jvs(180) = (jvs(180) + a) / jvs(114) 
+    a = 0.0; a = a  - jvs(94) * jvs(178) - jvs(115) * jvs(180)
+    jvs(181) = (jvs(181) + a) / jvs(135) 
+    a = 0.0; a = a  - jvs(95) * jvs(178) - jvs(116) * jvs(180)
+    jvs(182) = (jvs(182) + a) / jvs(141) 
+    a = 0.0; a = a  - jvs(96) * jvs(178)
+    jvs(183) = (jvs(183) + a) / jvs(152) 
+    a = 0.0; a = a  - jvs(97) * jvs(178) - jvs(108) * jvs(179) - jvs(117) * jvs(180) - jvs(136) * jvs(181)&
+          - jvs(142) * jvs(182) - jvs(153) * jvs(183)
+    jvs(184) = (jvs(184) + a) / jvs(163) 
+    jvs(185) = jvs(185) - jvs(7) * jvs(170) - jvs(11) * jvs(171) - jvs(17) * jvs(172) - jvs(31) * jvs(173)&
+          - jvs(35) * jvs(174) - jvs(53) * jvs(176) - jvs(98) * jvs(178) - jvs(118) * jvs(180) - jvs(154) * jvs(183)&
+          - jvs(164) * jvs(184)
+    jvs(186) = jvs(186) - jvs(12) * jvs(171) - jvs(32) * jvs(173) - jvs(36) * jvs(174) - jvs(41) * jvs(175)&
+          - jvs(54) * jvs(176) - jvs(59) * jvs(177) - jvs(99) * jvs(178) - jvs(109) * jvs(179) - jvs(119) * jvs(180)&
+          - jvs(137) * jvs(181) - jvs(143) * jvs(182) - jvs(155) * jvs(183) - jvs(165) * jvs(184)
+    jvs(187) = jvs(187) - jvs(37) * jvs(174) - jvs(100) * jvs(178) - jvs(166) * jvs(184)
+    jvs(188) = jvs(188) - jvs(101) * jvs(178) - jvs(120) * jvs(180) - jvs(138) * jvs(181) - jvs(144) * jvs(182)&
+          - jvs(156) * jvs(183) - jvs(167) * jvs(184)
+    jvs(189) = jvs(189) - jvs(13) * jvs(171) - jvs(18) * jvs(172) - jvs(60) * jvs(177) - jvs(102) * jvs(178)&
+          - jvs(110) * jvs(179) - jvs(121) * jvs(180) - jvs(139) * jvs(181) - jvs(145) * jvs(182) - jvs(157) * jvs(183)&
+          - jvs(168) * jvs(184)
+    jvs(190) = jvs(190) - jvs(33) * jvs(173) - jvs(42) * jvs(175) - jvs(61) * jvs(177) - jvs(103) * jvs(178)&
+          - jvs(111) * jvs(179) - jvs(158) * jvs(183) - jvs(169) * jvs(184)
+    jvs(191) = jvs(191) - jvs(8) * jvs(170) - jvs(104) * jvs(178)
+!   i = 27
+    jvs(192) = (jvs(192)) / jvs(1) 
+    jvs(193) = (jvs(193)) / jvs(3) 
+    jvs(194) = (jvs(194)) / jvs(14) 
+    jvs(195) = (jvs(195)) / jvs(19) 
+    jvs(196) = (jvs(196)) / jvs(30) 
+    jvs(197) = (jvs(197)) / jvs(34) 
+    jvs(198) = (jvs(198)) / jvs(44) 
+    a = 0.0; a = a  - jvs(45) * jvs(198)
+    jvs(199) = (jvs(199) + a) / jvs(58) 
+    jvs(200) = (jvs(200)) / jvs(63) 
+    jvs(201) = (jvs(201)) / jvs(69) 
+    a = 0.0; a = a  - jvs(70) * jvs(201)
+    jvs(202) = (jvs(202) + a) / jvs(80) 
+    a = 0.0; a = a  - jvs(64) * jvs(200) - jvs(71) * jvs(201)
+    jvs(203) = (jvs(203) + a) / jvs(107) 
+    jvs(204) = (jvs(204)) / jvs(114) 
+    a = 0.0; a = a  - jvs(46) * jvs(198) - jvs(72) * jvs(201)
+    jvs(205) = (jvs(205) + a) / jvs(124) 
+    a = 0.0; a = a  - jvs(65) * jvs(200) - jvs(73) * jvs(201) - jvs(81) * jvs(202) - jvs(115) * jvs(204)&
+          - jvs(125) * jvs(205)
+    jvs(206) = (jvs(206) + a) / jvs(135) 
+    a = 0.0; a = a  - jvs(74) * jvs(201) - jvs(116) * jvs(204) - jvs(126) * jvs(205)
+    jvs(207) = (jvs(207) + a) / jvs(141) 
+    a = 0.0; a = a  - jvs(47) * jvs(198) - jvs(75) * jvs(201) - jvs(127) * jvs(205)
+    jvs(208) = (jvs(208) + a) / jvs(152) 
+    a = 0.0; a = a  - jvs(2) * jvs(192) - jvs(66) * jvs(200) - jvs(76) * jvs(201) - jvs(82) * jvs(202)&
+          - jvs(108) * jvs(203) - jvs(117) * jvs(204) - jvs(128) * jvs(205) - jvs(136) * jvs(206) - jvs(142) * jvs(207)&
+          - jvs(153) * jvs(208)
+    jvs(209) = (jvs(209) + a) / jvs(163) 
+    a = 0.0; a = a  - jvs(31) * jvs(196) - jvs(35) * jvs(197) - jvs(48) * jvs(198) - jvs(118) * jvs(204)&
+          - jvs(154) * jvs(208) - jvs(164) * jvs(209)
+    jvs(210) = (jvs(210) + a) / jvs(185) 
+    jvs(211) = jvs(211) - jvs(4) * jvs(193) - jvs(15) * jvs(194) - jvs(20) * jvs(195) - jvs(32) * jvs(196)&
+          - jvs(36) * jvs(197) - jvs(49) * jvs(198) - jvs(59) * jvs(199) - jvs(67) * jvs(200) - jvs(77) * jvs(201)&
+          - jvs(83) * jvs(202) - jvs(109) * jvs(203) - jvs(119) * jvs(204) - jvs(129) * jvs(205) - jvs(137) * jvs(206)&
+          - jvs(143) * jvs(207) - jvs(155) * jvs(208) - jvs(165) * jvs(209) - jvs(186) * jvs(210)
+    jvs(212) = jvs(212) - jvs(5) * jvs(193) - jvs(37) * jvs(197) - jvs(130) * jvs(205) - jvs(166) * jvs(209)&
+          - jvs(187) * jvs(210)
+    jvs(213) = jvs(213) - jvs(78) * jvs(201) - jvs(84) * jvs(202) - jvs(120) * jvs(204) - jvs(131) * jvs(205)&
+          - jvs(138) * jvs(206) - jvs(144) * jvs(207) - jvs(156) * jvs(208) - jvs(167) * jvs(209) - jvs(188) * jvs(210)
+    jvs(214) = jvs(214) - jvs(50) * jvs(198) - jvs(60) * jvs(199) - jvs(79) * jvs(201) - jvs(110) * jvs(203)&
+          - jvs(121) * jvs(204) - jvs(132) * jvs(205) - jvs(139) * jvs(206) - jvs(145) * jvs(207) - jvs(157) * jvs(208)&
+          - jvs(168) * jvs(209) - jvs(189) * jvs(210)
+    jvs(215) = jvs(215) - jvs(33) * jvs(196) - jvs(61) * jvs(199) - jvs(111) * jvs(203) - jvs(133) * jvs(205)&
+          - jvs(158) * jvs(208) - jvs(169) * jvs(209) - jvs(190) * jvs(210)
+    jvs(216) = jvs(216) - jvs(134) * jvs(205) - jvs(191) * jvs(210)
+!   i = 28
+    jvs(217) = (jvs(217)) / jvs(3) 
+    jvs(218) = (jvs(218)) / jvs(14) 
+    jvs(219) = (jvs(219)) / jvs(19) 
+    jvs(220) = (jvs(220)) / jvs(34) 
+    jvs(221) = (jvs(221)) / jvs(40) 
+    jvs(222) = (jvs(222)) / jvs(51) 
+    jvs(223) = (jvs(223)) / jvs(58) 
+    jvs(224) = (jvs(224)) / jvs(63) 
+    jvs(225) = (jvs(225)) / jvs(69) 
+    a = 0.0; a = a  - jvs(70) * jvs(225)
+    jvs(226) = (jvs(226) + a) / jvs(80) 
+    a = 0.0; a = a  - jvs(64) * jvs(224) - jvs(71) * jvs(225)
+    jvs(227) = (jvs(227) + a) / jvs(107) 
+    a = 0.0; a = a  - jvs(52) * jvs(222)
+    jvs(228) = (jvs(228) + a) / jvs(114) 
+    a = 0.0; a = a  - jvs(72) * jvs(225)
+    jvs(229) = (jvs(229) + a) / jvs(124) 
+    a = 0.0; a = a  - jvs(65) * jvs(224) - jvs(73) * jvs(225) - jvs(81) * jvs(226) - jvs(115) * jvs(228)&
+          - jvs(125) * jvs(229)
+    jvs(230) = (jvs(230) + a) / jvs(135) 
+    a = 0.0; a = a  - jvs(74) * jvs(225) - jvs(116) * jvs(228) - jvs(126) * jvs(229)
+    jvs(231) = (jvs(231) + a) / jvs(141) 
+    a = 0.0; a = a  - jvs(75) * jvs(225) - jvs(127) * jvs(229)
+    jvs(232) = (jvs(232) + a) / jvs(152) 
+    a = 0.0; a = a  - jvs(66) * jvs(224) - jvs(76) * jvs(225) - jvs(82) * jvs(226) - jvs(108) * jvs(227)&
+          - jvs(117) * jvs(228) - jvs(128) * jvs(229) - jvs(136) * jvs(230) - jvs(142) * jvs(231) - jvs(153) * jvs(232)
+    jvs(233) = (jvs(233) + a) / jvs(163) 
+    a = 0.0; a = a  - jvs(35) * jvs(220) - jvs(53) * jvs(222) - jvs(118) * jvs(228) - jvs(154) * jvs(232)&
+          - jvs(164) * jvs(233)
+    jvs(234) = (jvs(234) + a) / jvs(185) 
+    a = 0.0; a = a  - jvs(4) * jvs(217) - jvs(15) * jvs(218) - jvs(20) * jvs(219) - jvs(36) * jvs(220)&
+          - jvs(41) * jvs(221) - jvs(54) * jvs(222) - jvs(59) * jvs(223) - jvs(67) * jvs(224) - jvs(77) * jvs(225)&
+          - jvs(83) * jvs(226) - jvs(109) * jvs(227) - jvs(119) * jvs(228) - jvs(129) * jvs(229) - jvs(137) * jvs(230)&
+          - jvs(143) * jvs(231) - jvs(155) * jvs(232) - jvs(165) * jvs(233) - jvs(186) * jvs(234)
+    jvs(235) = (jvs(235) + a) / jvs(211) 
+    jvs(236) = jvs(236) - jvs(5) * jvs(217) - jvs(37) * jvs(220) - jvs(130) * jvs(229) - jvs(166) * jvs(233)&
+          - jvs(187) * jvs(234) - jvs(212) * jvs(235)
+    jvs(237) = jvs(237) - jvs(78) * jvs(225) - jvs(84) * jvs(226) - jvs(120) * jvs(228) - jvs(131) * jvs(229)&
+          - jvs(138) * jvs(230) - jvs(144) * jvs(231) - jvs(156) * jvs(232) - jvs(167) * jvs(233) - jvs(188) * jvs(234)&
+          - jvs(213) * jvs(235)
+    jvs(238) = jvs(238) - jvs(60) * jvs(223) - jvs(79) * jvs(225) - jvs(110) * jvs(227) - jvs(121) * jvs(228)&
+          - jvs(132) * jvs(229) - jvs(139) * jvs(230) - jvs(145) * jvs(231) - jvs(157) * jvs(232) - jvs(168) * jvs(233)&
+          - jvs(189) * jvs(234) - jvs(214) * jvs(235)
+    jvs(239) = jvs(239) - jvs(42) * jvs(221) - jvs(61) * jvs(223) - jvs(111) * jvs(227) - jvs(133) * jvs(229)&
+          - jvs(158) * jvs(232) - jvs(169) * jvs(233) - jvs(190) * jvs(234) - jvs(215) * jvs(235)
+    jvs(240) = jvs(240) - jvs(134) * jvs(229) - jvs(191) * jvs(234) - jvs(216) * jvs(235)
+!   i = 29
+    jvs(241) = (jvs(241)) / jvs(1) 
+    jvs(242) = (jvs(242)) / jvs(80) 
+    jvs(243) = (jvs(243)) / jvs(124) 
+    a = 0.0; a = a  - jvs(81) * jvs(242) - jvs(125) * jvs(243)
+    jvs(244) = (jvs(244) + a) / jvs(135) 
+    a = 0.0; a = a  - jvs(126) * jvs(243)
+    jvs(245) = (jvs(245) + a) / jvs(141) 
+    a = 0.0; a = a  - jvs(127) * jvs(243)
+    jvs(246) = (jvs(246) + a) / jvs(152) 
+    a = 0.0; a = a  - jvs(2) * jvs(241) - jvs(82) * jvs(242) - jvs(128) * jvs(243) - jvs(136) * jvs(244)&
+          - jvs(142) * jvs(245) - jvs(153) * jvs(246)
+    jvs(247) = (jvs(247) + a) / jvs(163) 
+    a = 0.0; a = a  - jvs(154) * jvs(246) - jvs(164) * jvs(247)
+    jvs(248) = (jvs(248) + a) / jvs(185) 
+    a = 0.0; a = a  - jvs(83) * jvs(242) - jvs(129) * jvs(243) - jvs(137) * jvs(244) - jvs(143) * jvs(245)&
+          - jvs(155) * jvs(246) - jvs(165) * jvs(247) - jvs(186) * jvs(248)
+    jvs(249) = (jvs(249) + a) / jvs(211) 
+    a = 0.0; a = a  - jvs(130) * jvs(243) - jvs(166) * jvs(247) - jvs(187) * jvs(248) - jvs(212) * jvs(249)
+    jvs(250) = (jvs(250) + a) / jvs(236) 
+    jvs(251) = jvs(251) - jvs(84) * jvs(242) - jvs(131) * jvs(243) - jvs(138) * jvs(244) - jvs(144) * jvs(245)&
+          - jvs(156) * jvs(246) - jvs(167) * jvs(247) - jvs(188) * jvs(248) - jvs(213) * jvs(249) - jvs(237) * jvs(250)
+    jvs(252) = jvs(252) - jvs(132) * jvs(243) - jvs(139) * jvs(244) - jvs(145) * jvs(245) - jvs(157) * jvs(246)&
+          - jvs(168) * jvs(247) - jvs(189) * jvs(248) - jvs(214) * jvs(249) - jvs(238) * jvs(250)
+    jvs(253) = jvs(253) - jvs(133) * jvs(243) - jvs(158) * jvs(246) - jvs(169) * jvs(247) - jvs(190) * jvs(248)&
+          - jvs(215) * jvs(249) - jvs(239) * jvs(250)
+    jvs(254) = jvs(254) - jvs(134) * jvs(243) - jvs(191) * jvs(248) - jvs(216) * jvs(249) - jvs(240) * jvs(250)
+!   i = 30
+    jvs(255) = (jvs(255)) / jvs(16) 
+    jvs(256) = (jvs(256)) / jvs(44) 
+    a = 0.0; a = a  - jvs(45) * jvs(256)
+    jvs(257) = (jvs(257) + a) / jvs(58) 
+    a = 0.0; a = a  - jvs(46) * jvs(256)
+    jvs(258) = (jvs(258) + a) / jvs(124) 
+    a = 0.0; a = a  - jvs(125) * jvs(258)
+    jvs(259) = (jvs(259) + a) / jvs(135) 
+    a = 0.0; a = a  - jvs(126) * jvs(258)
+    jvs(260) = (jvs(260) + a) / jvs(141) 
+    a = 0.0; a = a  - jvs(47) * jvs(256) - jvs(127) * jvs(258)
+    jvs(261) = (jvs(261) + a) / jvs(152) 
+    a = 0.0; a = a  - jvs(128) * jvs(258) - jvs(136) * jvs(259) - jvs(142) * jvs(260) - jvs(153) * jvs(261)
+    jvs(262) = (jvs(262) + a) / jvs(163) 
+    a = 0.0; a = a  - jvs(17) * jvs(255) - jvs(48) * jvs(256) - jvs(154) * jvs(261) - jvs(164) * jvs(262)
+    jvs(263) = (jvs(263) + a) / jvs(185) 
+    a = 0.0; a = a  - jvs(49) * jvs(256) - jvs(59) * jvs(257) - jvs(129) * jvs(258) - jvs(137) * jvs(259)&
+          - jvs(143) * jvs(260) - jvs(155) * jvs(261) - jvs(165) * jvs(262) - jvs(186) * jvs(263)
+    jvs(264) = (jvs(264) + a) / jvs(211) 
+    a = 0.0; a = a  - jvs(130) * jvs(258) - jvs(166) * jvs(262) - jvs(187) * jvs(263) - jvs(212) * jvs(264)
+    jvs(265) = (jvs(265) + a) / jvs(236) 
+    a = 0.0; a = a  - jvs(131) * jvs(258) - jvs(138) * jvs(259) - jvs(144) * jvs(260) - jvs(156) * jvs(261)&
+          - jvs(167) * jvs(262) - jvs(188) * jvs(263) - jvs(213) * jvs(264) - jvs(237) * jvs(265)
+    jvs(266) = (jvs(266) + a) / jvs(251) 
+    jvs(267) = jvs(267) - jvs(18) * jvs(255) - jvs(50) * jvs(256) - jvs(60) * jvs(257) - jvs(132) * jvs(258)&
+          - jvs(139) * jvs(259) - jvs(145) * jvs(260) - jvs(157) * jvs(261) - jvs(168) * jvs(262) - jvs(189) * jvs(263)&
+          - jvs(214) * jvs(264) - jvs(238) * jvs(265) - jvs(252) * jvs(266)
+    jvs(268) = jvs(268) - jvs(61) * jvs(257) - jvs(133) * jvs(258) - jvs(158) * jvs(261) - jvs(169) * jvs(262)&
+          - jvs(190) * jvs(263) - jvs(215) * jvs(264) - jvs(239) * jvs(265) - jvs(253) * jvs(266)
+    jvs(269) = jvs(269) - jvs(134) * jvs(258) - jvs(191) * jvs(263) - jvs(216) * jvs(264) - jvs(240) * jvs(265)&
+          - jvs(254) * jvs(266)
+!   i = 31
+    jvs(270) = (jvs(270)) / jvs(21) 
+    jvs(271) = (jvs(271)) / jvs(30) 
+    jvs(272) = (jvs(272)) / jvs(40) 
+    a = 0.0; a = a  - jvs(22) * jvs(270)
+    jvs(273) = (jvs(273) + a) / jvs(51) 
+    jvs(274) = (jvs(274)) / jvs(91) 
+    a = 0.0; a = a  - jvs(92) * jvs(274)
+    jvs(275) = (jvs(275) + a) / jvs(107) 
+    a = 0.0; a = a  - jvs(23) * jvs(270) - jvs(52) * jvs(273) - jvs(93) * jvs(274)
+    jvs(276) = (jvs(276) + a) / jvs(114) 
+    a = 0.0; a = a  - jvs(24) * jvs(270) - jvs(94) * jvs(274) - jvs(115) * jvs(276)
+    jvs(277) = (jvs(277) + a) / jvs(135) 
+    a = 0.0; a = a  - jvs(25) * jvs(270) - jvs(95) * jvs(274) - jvs(116) * jvs(276)
+    jvs(278) = (jvs(278) + a) / jvs(141) 
+    a = 0.0; a = a  - jvs(96) * jvs(274)
+    jvs(279) = (jvs(279) + a) / jvs(152) 
+    a = 0.0; a = a  - jvs(97) * jvs(274) - jvs(108) * jvs(275) - jvs(117) * jvs(276) - jvs(136) * jvs(277)&
+          - jvs(142) * jvs(278) - jvs(153) * jvs(279)
+    jvs(280) = (jvs(280) + a) / jvs(163) 
+    a = 0.0; a = a  - jvs(31) * jvs(271) - jvs(53) * jvs(273) - jvs(98) * jvs(274) - jvs(118) * jvs(276)&
+          - jvs(154) * jvs(279) - jvs(164) * jvs(280)
+    jvs(281) = (jvs(281) + a) / jvs(185) 
+    a = 0.0; a = a  - jvs(26) * jvs(270) - jvs(32) * jvs(271) - jvs(41) * jvs(272) - jvs(54) * jvs(273)&
+          - jvs(99) * jvs(274) - jvs(109) * jvs(275) - jvs(119) * jvs(276) - jvs(137) * jvs(277) - jvs(143) * jvs(278)&
+          - jvs(155) * jvs(279) - jvs(165) * jvs(280) - jvs(186) * jvs(281)
+    jvs(282) = (jvs(282) + a) / jvs(211) 
+    a = 0.0; a = a  - jvs(100) * jvs(274) - jvs(166) * jvs(280) - jvs(187) * jvs(281) - jvs(212) * jvs(282)
+    jvs(283) = (jvs(283) + a) / jvs(236) 
+    a = 0.0; a = a  - jvs(27) * jvs(270) - jvs(101) * jvs(274) - jvs(120) * jvs(276) - jvs(138) * jvs(277)&
+          - jvs(144) * jvs(278) - jvs(156) * jvs(279) - jvs(167) * jvs(280) - jvs(188) * jvs(281) - jvs(213) * jvs(282)&
+          - jvs(237) * jvs(283)
+    jvs(284) = (jvs(284) + a) / jvs(251) 
+    a = 0.0; a = a  - jvs(28) * jvs(270) - jvs(102) * jvs(274) - jvs(110) * jvs(275) - jvs(121) * jvs(276)&
+          - jvs(139) * jvs(277) - jvs(145) * jvs(278) - jvs(157) * jvs(279) - jvs(168) * jvs(280) - jvs(189) * jvs(281)&
+          - jvs(214) * jvs(282) - jvs(238) * jvs(283) - jvs(252) * jvs(284)
+    jvs(285) = (jvs(285) + a) / jvs(267) 
+    jvs(286) = jvs(286) - jvs(29) * jvs(270) - jvs(33) * jvs(271) - jvs(42) * jvs(272) - jvs(103) * jvs(274)&
+          - jvs(111) * jvs(275) - jvs(158) * jvs(279) - jvs(169) * jvs(280) - jvs(190) * jvs(281) - jvs(215) * jvs(282)&
+          - jvs(239) * jvs(283) - jvs(253) * jvs(284) - jvs(268) * jvs(285)
+    jvs(287) = jvs(287) - jvs(104) * jvs(274) - jvs(191) * jvs(281) - jvs(216) * jvs(282) - jvs(240) * jvs(283)&
+          - jvs(254) * jvs(284) - jvs(269) * jvs(285)
+!   i = 32
+    jvs(288) = (jvs(288)) / jvs(6) 
+    jvs(289) = (jvs(289)) / jvs(63) 
+    a = 0.0; a = a  - jvs(64) * jvs(289)
+    jvs(290) = (jvs(290) + a) / jvs(107) 
+    a = 0.0; a = a  - jvs(65) * jvs(289)
+    jvs(291) = (jvs(291) + a) / jvs(135) 
+    jvs(292) = (jvs(292)) / jvs(152) 
+    a = 0.0; a = a  - jvs(66) * jvs(289) - jvs(108) * jvs(290) - jvs(136) * jvs(291) - jvs(153) * jvs(292)
+    jvs(293) = (jvs(293) + a) / jvs(163) 
+    a = 0.0; a = a  - jvs(7) * jvs(288) - jvs(154) * jvs(292) - jvs(164) * jvs(293)
+    jvs(294) = (jvs(294) + a) / jvs(185) 
+    a = 0.0; a = a  - jvs(67) * jvs(289) - jvs(109) * jvs(290) - jvs(137) * jvs(291) - jvs(155) * jvs(292)&
+          - jvs(165) * jvs(293) - jvs(186) * jvs(294)
+    jvs(295) = (jvs(295) + a) / jvs(211) 
+    a = 0.0; a = a  - jvs(166) * jvs(293) - jvs(187) * jvs(294) - jvs(212) * jvs(295)
+    jvs(296) = (jvs(296) + a) / jvs(236) 
+    a = 0.0; a = a  - jvs(138) * jvs(291) - jvs(156) * jvs(292) - jvs(167) * jvs(293) - jvs(188) * jvs(294)&
+          - jvs(213) * jvs(295) - jvs(237) * jvs(296)
+    jvs(297) = (jvs(297) + a) / jvs(251) 
+    a = 0.0; a = a  - jvs(110) * jvs(290) - jvs(139) * jvs(291) - jvs(157) * jvs(292) - jvs(168) * jvs(293)&
+          - jvs(189) * jvs(294) - jvs(214) * jvs(295) - jvs(238) * jvs(296) - jvs(252) * jvs(297)
+    jvs(298) = (jvs(298) + a) / jvs(267) 
+    a = 0.0; a = a  - jvs(111) * jvs(290) - jvs(158) * jvs(292) - jvs(169) * jvs(293) - jvs(190) * jvs(294)&
+          - jvs(215) * jvs(295) - jvs(239) * jvs(296) - jvs(253) * jvs(297) - jvs(268) * jvs(298)
+    jvs(299) = (jvs(299) + a) / jvs(286) 
+    jvs(300) = jvs(300) - jvs(8) * jvs(288) - jvs(191) * jvs(294) - jvs(216) * jvs(295) - jvs(240) * jvs(296)&
+          - jvs(254) * jvs(297) - jvs(269) * jvs(298) - jvs(287) * jvs(299)
+    RETURN                                                            
+                                                                      
+  END SUBROUTINE kppdecomp                                            
+ 
+SUBROUTINE chem_gasphase_integrate (time_step_len, conc, tempi, qvapi, fakti, photo, ierrf, xnacc, xnrej, istatus, l_debug, pe, &
+                     icntrl_i, rcntrl_i) 
+                                                                    
+  IMPLICIT NONE                                                     
+                                                                    
+  REAL(dp), INTENT(IN)                  :: time_step_len           
+  REAL(dp), DIMENSION(:, :), INTENT(INOUT) :: conc                    
+  REAL(dp), DIMENSION(:, :), INTENT(IN)   :: photo                   
+  REAL(dp), DIMENSION(:), INTENT(IN)     :: tempi                   
+  REAL(dp), DIMENSION(:), INTENT(IN)     :: qvapi                   
+  REAL(dp), DIMENSION(:), INTENT(IN)     :: fakti                   
+  INTEGER, INTENT(OUT), OPTIONAL        :: ierrf(:)               
+  INTEGER, INTENT(OUT), OPTIONAL        :: xnacc(:)               
+  INTEGER, INTENT(OUT), OPTIONAL        :: xnrej(:)               
+  INTEGER, INTENT(INOUT), OPTIONAL      :: istatus(:)             
+  INTEGER, INTENT(IN), OPTIONAL         :: pe                      
+  LOGICAL, INTENT(IN), OPTIONAL         :: l_debug                 
+  INTEGER, DIMENSION(nkppctrl), INTENT(IN), OPTIONAL  :: icntrl_i         
+  REAL(dp), DIMENSION(nkppctrl), INTENT(IN), OPTIONAL  :: rcntrl_i         
+                                                                    
+  INTEGER                                 :: k   ! loop variable     
+  REAL(dp)                               :: dt                      
+  INTEGER, DIMENSION(20)                :: istatus_u               
+  INTEGER                                :: ierr_u                  
+  INTEGER                                :: istatf                  
+  INTEGER                                :: vl_dim_lo               
+                                                                    
+                                                                    
+  IF (PRESENT (istatus)) istatus = 0                             
+  IF (PRESENT (icntrl_i)) icntrl  = icntrl_i                      
+  IF (PRESENT (rcntrl_i)) rcntrl  = rcntrl_i                      
+                                                                    
+  vl_glo = size(tempi, 1)                                           
+                                                                    
+  vl_dim_lo = vl_dim                                                
+  DO k=1, vl_glo, vl_dim_lo                                           
+    is = k                                                          
+    ie = min(k+ vl_dim_lo-1, vl_glo)                                 
+    vl = ie-is+ 1                                                    
+                                                                    
+    c(:) = conc(is, :)                                            
+                                                                    
+    temp = tempi(is)                                             
+                                                                    
+    qvap = qvapi(is)                                             
+                                                                    
+    fakt = fakti(is)                                             
+                                                                    
+    CALL initialize                                                 
+                                                                    
+    phot(:) = photo(is, :)                                            
+                                                                    
+    CALL update_rconst                                              
+                                                                    
+    dt = time_step_len                                              
+                                                                    
+    ! integrate from t=0 to t=dt                                    
+    CALL integrate(0._dp, dt, icntrl, rcntrl, istatus_u = istatus_u, ierr_u=ierr_u)
+                                                                    
+                                                                    
+   IF (PRESENT(l_debug) .AND. PRESENT(pe)) THEN                       
+      IF (l_debug) CALL error_output(conc(is, :), ierr_u, pe)          
+   ENDIF                                                              
+                                                                      
+    conc(is, :) = c(:)                                                
+                                                                    
+    ! RETURN diagnostic information                                 
+                                                                    
+    IF (PRESENT(ierrf))   ierrf(is) = ierr_u                      
+    IF (PRESENT(xnacc))   xnacc(is) = istatus_u(4)               
+    IF (PRESENT(xnrej))   xnrej(is) = istatus_u(5)               
+                                                                    
+    IF (PRESENT (istatus)) THEN                                   
+      istatus(1:8) = istatus(1:8) + istatus_u(1:8)                
+    ENDIF                                                          
+                                                                    
+  END DO                                                            
+ 
+                                                                    
+! Deallocate input arrays                                           
+                                                                    
+                                                                    
+  data_loaded = .FALSE.                                             
+                                                                    
+  RETURN                                                            
+END SUBROUTINE chem_gasphase_integrate                                        
+
+END MODULE chem_gasphase_mod
+ 
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_cbm4/chem_gasphase_mod.kpp
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_cbm4/chem_gasphase_mod.kpp	(revision 3298)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_cbm4/chem_gasphase_mod.kpp	(revision 3298)
@@ -0,0 +1,56 @@
+//chem_gasphase_mod.kpp
+//
+//Former revisions
+//----------------
+// $Id: chem_gasphase_mod.kpp 2459 2017-09-13 14:10:33Z forkel $
+//
+#include      cbm4.spc
+#include      cbm4.eqn
+#INTEGRATOR rosenbrock
+#LANGUAGE   Fortran90
+#HESSIAN    on
+#STOICMAT   on
+//
+#INLINE F90_GLOBAL
+! QVAP - Water vapor
+  REAL(kind=dp) :: QVAP
+! FAKT - Conversion factor
+  REAL(kind=dp) :: FAKT
+
+  !   Declaration of global variable declarations for photolysis will come from INLINE F90_DATA
+#ENDINLINE
+//
+// *******************************************************************************************
+// *** adapt the lines below occurding to the photolysis reactions of your mechanism         *
+// *** adapt the number of photolysis frequencies NPHO                                       *
+// *** adapt/extend the indices in the INTEGER, PARAMETER,PUBLIC statement below             *
+// *** adapt/extend PHOT_NAMES: Note that the order of PHOT_NAMES and the indices must match *
+// *******************************************************************************************
+//
+#INLINE F90_DATA
+  !   INLINE F90_DATA: Declaration of global variables for photolysis
+  !   REAL(kind=dp) :: phot(nphot) must eventually be moved to GLOBAL later for vector version
+  INTEGER, PARAMETER :: nphot = 9
+  !   phot Photolysis frequencies 
+  REAL(kind=dp) :: phot(nphot)
+
+  INTEGER, PARAMETER,PUBLIC :: j_no2 = 1
+  INTEGER, PARAMETER,PUBLIC :: j_o33p = 2
+  INTEGER, PARAMETER,PUBLIC :: j_o31d = 3
+  INTEGER, PARAMETER,PUBLIC :: j_no3o = 4
+  INTEGER, PARAMETER,PUBLIC :: j_no3o2 = 5
+  INTEGER, PARAMETER,PUBLIC :: j_hono = 6
+  INTEGER, PARAMETER,PUBLIC :: j_h2o2 = 7
+  INTEGER, PARAMETER,PUBLIC :: j_ch2or = 8
+  INTEGER, PARAMETER,PUBLIC :: j_ch2om = 9
+
+  CHARACTER(LEN=15), PARAMETER, DIMENSION(NPHOT) :: phot_names =  (/ &
+     'J_NO2          ','J_O33P         ','J_O31D         ',          &
+     'J_NO3O         ','J_NO3O2        ','J_HONO         ',          &
+     'J_H2O2         ','J_HCHO_B       ','J_HCHO_A       '/)
+#ENDINLINE
+
+#INLINE F90_INIT
+  fix(indf_h2o) = qvap 
+#ENDINLINE
+
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_passive/chem_gasphase_mod.f90
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_passive/chem_gasphase_mod.f90	(revision 3298)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_passive/chem_gasphase_mod.f90	(revision 3298)
@@ -0,0 +1,2328 @@
+MODULE chem_gasphase_mod
+ 
+!   Mechanism: passive
+!
+!------------------------------------------------------------------------------!
+!
+! ******Module chem_gasphase_mod is automatically generated by kpp4palm ******
+!
+!   *********Please do NOT change this Code,it will be ovewritten *********
+!
+!------------------------------------------------------------------------------!
+! This file was created by KPP (http://people.cs.vt.edu/asandu/Software/Kpp/)
+! and kpp4palm (created by Klaus Ketelsen). kpp4palm is an adapted version 
+! of KP4 (JÃ¶ckel,P.,Kerkweg,A.,Pozzer,A.,Sander,R.,Tost,H.,Riede,
+! H.,Baumgaertner,A.,Gromov,S.,and Kern,B.,2010: Development cycle 2 of
+! the Modular Earth Submodel System (MESSy2),Geosci. Model Dev.,3,717-752,
+! https://doi.org/10.5194/gmd-3-717-2010). KP4 is part of the Modular Earth 
+! Submodel System (MESSy),which is is available under the  GNU General Public 
+! License (GPL).
+!
+! KPP is free software; you can redistribute it and/or modify it under the terms 
+! of the General Public Licence as published by the Free Software Foundation; 
+! either version 2 of the License,or (at your option) any later version. 
+! KPP is distributed in the hope that it will be useful,but WITHOUT ANY WARRANTY; 
+! without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 
+! PURPOSE. See the GNU General Public Licence for more details. 
+!
+!------------------------------------------------------------------------------!
+! This file is part of the PALM model system.
+!
+! PALM is free software: you can redistribute it and/or modify it under the
+! terms of the GNU General Public License as published by the Free Software
+! Foundation,either version 3 of the License,or (at your option) any later
+! version.
+!
+! PALM is distributed in the hope that it will be useful,but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not,see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2018 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! ------------------
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id: module_header 2460 2017-09-13 14:47:48Z forkel $
+! forkel June 2018: qvap,fakt added
+! forkel June 2018: reset case in  Initialize,Integrate,Update_rconst
+! 
+! 
+! 2460 2017-09-13 14:47:48Z forkel
+!
+! forkel Sept. 2017: Variables for photolyis added
+!
+!
+! Nov. 2016: Intial version (Klaus Ketelsen)
+!
+!------------------------------------------------------------------------------!
+!
+
+
+! Set kpp Double Precision to PALM Default Precision
+
+  USE kinds,           ONLY: dp=>wp
+
+  USE pegrid,          ONLY: myid, threads_per_task
+
+  IMPLICIT        NONE
+  PRIVATE
+  !SAVE  ! note: occurs again in automatically generated code ...
+
+!  PUBLIC :: IERR_NAMES
+ 
+! PUBLIC :: SPC_NAMES,EQN_NAMES,EQN_TAGS,REQ_HET,REQ_AEROSOL,REQ_PHOTRAT &
+!         ,REQ_MCFCT,IP_MAX,jname
+
+  PUBLIC :: eqn_names, phot_names, spc_names
+  PUBLIC :: nmaxfixsteps
+  PUBLIC :: atol, rtol
+  PUBLIC :: nspec, nreact
+  PUBLIC :: temp
+  PUBLIC :: qvap
+  PUBLIC :: fakt
+  PUBLIC :: phot 
+  PUBLIC :: rconst
+  PUBLIC :: nvar
+  PUBLIC :: nphot
+  PUBLIC :: vl_dim                     ! PUBLIC to ebable other MODULEs to distiguish between scalar and vec
+ 
+  PUBLIC :: initialize, integrate, update_rconst
+  PUBLIC :: chem_gasphase_integrate
+  PUBLIC :: initialize_kpp_ctrl
+
+! END OF MODULE HEADER TEMPLATE
+                                                                 
+! Variables used for vector mode                                 
+                                                                 
+  LOGICAL, PARAMETER          :: l_vector = .FALSE.            
+  INTEGER, PARAMETER          :: i_lu_di = 2
+  INTEGER, PARAMETER          :: vl_dim = 1
+  INTEGER                     :: vl                              
+                                                                 
+  INTEGER                     :: vl_glo                          
+  INTEGER                     :: is, ie                           
+                                                                 
+                                                                 
+  INTEGER, DIMENSION(vl_dim)  :: kacc, krej                       
+  INTEGER, DIMENSION(vl_dim)  :: ierrv                           
+  LOGICAL                     :: data_loaded = .FALSE.             
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Parameter Module File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Parameters.f90
+! Time                 : Tue Sep 25 18:34:57 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! NSPEC - Number of chemical species
+  INTEGER, PARAMETER :: nspec = 2 
+! NVAR - Number of Variable species
+  INTEGER, PARAMETER :: nvar = 2 
+! NVARACT - Number of Active species
+  INTEGER, PARAMETER :: nvaract = 2 
+! NFIX - Number of Fixed species
+  INTEGER, PARAMETER :: nfix = 1 
+! NREACT - Number of reactions
+  INTEGER, PARAMETER :: nreact = 2 
+! NVARST - Starting of variables in conc. vect.
+  INTEGER, PARAMETER :: nvarst = 1 
+! NFIXST - Starting of fixed in conc. vect.
+  INTEGER, PARAMETER :: nfixst = 3 
+! NONZERO - Number of nonzero entries in Jacobian
+  INTEGER, PARAMETER :: nonzero = 2 
+! LU_NONZERO - Number of nonzero entries in LU factoriz. of Jacobian
+  INTEGER, PARAMETER :: lu_nonzero = 2 
+! CNVAR - (NVAR+1) Number of elements in compressed row format
+  INTEGER, PARAMETER :: cnvar = 3 
+! CNEQN - (NREACT+1) Number stoicm elements in compressed col format
+  INTEGER, PARAMETER :: cneqn = 3 
+! NHESS - Length of Sparse Hessian
+  INTEGER, PARAMETER :: nhess = 1 
+! NMASS - Number of atoms to check mass balance
+  INTEGER, PARAMETER :: nmass = 1 
+
+! Index declaration for variable species in C and VAR
+!   VAR(ind_spc) = C(ind_spc)
+
+  INTEGER, PARAMETER, PUBLIC :: ind_pm10 = 1 
+  INTEGER, PARAMETER, PUBLIC :: ind_pm25 = 2 
+
+! Index declaration for fixed species in C
+!   C(ind_spc)
+
+
+! Index declaration for fixed species in FIX
+!    FIX(indf_spc) = C(ind_spc) = C(NVAR+indf_spc)
+
+
+! NJVRP - Length of sparse Jacobian JVRP
+  INTEGER, PARAMETER :: njvrp = 2 
+
+! NSTOICM - Length of Sparse Stoichiometric Matrix
+  INTEGER, PARAMETER :: nstoicm = 1 
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Global Data Module File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Global.f90
+! Time                 : Tue Sep 25 18:34:57 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! Declaration of global variables
+
+! C - Concentration of all species
+  REAL(kind=dp):: c(nspec)
+! VAR - Concentrations of variable species (global)
+  REAL(kind=dp):: var(nvar)
+! FIX - Concentrations of fixed species (global)
+  REAL(kind=dp):: fix(nfix)
+! VAR,FIX are chunks of array C
+      EQUIVALENCE( c(1), var(1))
+! RCONST - Rate constants (global)
+  REAL(kind=dp):: rconst(nreact)
+! TIME - Current integration time
+  REAL(kind=dp):: time
+! TEMP - Temperature
+  REAL(kind=dp):: temp
+! TSTART - Integration start time
+  REAL(kind=dp):: tstart
+! ATOL - Absolute tolerance
+  REAL(kind=dp):: atol(nvar)
+! RTOL - Relative tolerance
+  REAL(kind=dp):: rtol(nvar)
+! STEPMIN - Lower bound for integration step
+  REAL(kind=dp):: stepmin
+! CFACTOR - Conversion factor for concentration units
+  REAL(kind=dp):: cfactor
+
+! INLINED global variable declarations
+
+! QVAP - Water vapor
+  REAL(kind=dp):: qvap
+! FAKT - Conversion factor
+  REAL(kind=dp):: fakt
+
+
+! INLINED global variable declarations
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Sparse Jacobian Data Structures File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_JacobianSP.f90
+! Time                 : Tue Sep 25 18:34:57 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! Sparse Jacobian Data
+
+
+  INTEGER, PARAMETER, DIMENSION(2):: lu_irow =  (/ &
+       1, 2 /) 
+
+  INTEGER, PARAMETER, DIMENSION(2):: lu_icol =  (/ &
+       1, 2 /) 
+
+  INTEGER, PARAMETER, DIMENSION(3):: lu_crow =  (/ &
+       1, 2, 3 /) 
+
+  INTEGER, PARAMETER, DIMENSION(3):: lu_diag =  (/ &
+       1, 2, 3 /) 
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Utility Data Module File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Monitor.f90
+! Time                 : Tue Sep 25 18:34:57 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+  CHARACTER(len=15), PARAMETER, DIMENSION(2):: spc_names =  (/ &
+     'PM10           ','PM25           ' /)
+
+  CHARACTER(len=100), PARAMETER, DIMENSION(2):: eqn_names =  (/ &
+     'PM10 --> PM10                                                                                       ',&
+     'PM25 --> PM25                                                                                       ' /)
+
+! INLINED global variables
+
+  !   inline f90_data: declaration of global variables for photolysis
+  !   REAL(kind=dp):: phot(nphot)must eventually be moved to global later for 
+  INTEGER, PARAMETER :: nphot = 1
+  !   phot photolysis frequencies
+  REAL(kind=dp):: phot(nphot)
+
+  INTEGER, PARAMETER, PUBLIC :: j_no2 = 1
+
+  CHARACTER(len=15), PARAMETER, DIMENSION(nphot):: phot_names =   (/ &
+     'J_NO2          '/)
+
+! End INLINED global variables
+
+
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+ 
+!  variable definations from  individual module headers 
+ 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Initialization File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Initialize.f90
+! Time                 : Tue Sep 25 18:34:57 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Numerical Integrator (Time-Stepping) File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Integrator.f90
+! Time                 : Tue Sep 25 18:34:57 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! INTEGRATE - Integrator routine
+!   Arguments :
+!      TIN       - Start Time for Integration
+!      TOUT      - End Time for Integration
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
+!  Rosenbrock - Implementation of several Rosenbrock methods:             !
+!               *Ros2                                                    !
+!               *Ros3                                                    !
+!               *Ros4                                                    !
+!               *Rodas3                                                  !
+!               *Rodas4                                                  !
+!  By default the code employs the KPP sparse linear algebra routines     !
+!  Compile with -DFULL_ALGEBRA to use full linear algebra (LAPACK)        !
+!                                                                         !
+!    (C)  Adrian Sandu,August 2004                                       !
+!    Virginia Polytechnic Institute and State University                  !
+!    Contact: sandu@cs.vt.edu                                             !
+!    Revised by Philipp Miehe and Adrian Sandu,May 2006                  !                               !
+!    This implementation is part of KPP - the Kinetic PreProcessor        !
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
+
+
+  SAVE
+  
+!~~~>  statistics on the work performed by the rosenbrock method
+  INTEGER, PARAMETER :: nfun=1, njac=2, nstp=3, nacc=4, &
+                        nrej=5, ndec=6, nsol=7, nsng=8, &
+                        ntexit=1, nhexit=2, nhnew = 3
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Linear Algebra Data and Routines File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_LinearAlgebra.f90
+! Time                 : Tue Sep 25 18:34:57 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! The ODE Jacobian of Chemical Model File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Jacobian.f90
+! Time                 : Tue Sep 25 18:34:57 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! The ODE Function of Chemical Model File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Function.f90
+! Time                 : Tue Sep 25 18:34:57 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+! A - Rate for each equation
+  REAL(kind=dp):: a(nreact)
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! The Reaction Rates File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Rates.f90
+! Time                 : Tue Sep 25 18:34:57 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Auxiliary Routines File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Util.f90
+! Time                 : Tue Sep 25 18:34:57 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+  ! header MODULE initialize_kpp_ctrl_template
+
+  ! notes:
+  ! - l_vector is automatically defined by kp4
+  ! - vl_dim is automatically defined by kp4
+  ! - i_lu_di is automatically defined by kp4
+  ! - wanted is automatically defined by xmecca
+  ! - icntrl rcntrl are automatically defined by kpp
+  ! - "USE messy_main_tools" is in MODULE_header of messy_mecca_kpp.f90
+  ! - SAVE will be automatically added by kp4
+
+  !SAVE
+
+  ! for fixed time step control
+  ! ... max. number of fixed time steps (sum must be 1)
+  INTEGER, PARAMETER         :: nmaxfixsteps = 50
+  ! ... switch for fixed time stepping
+  LOGICAL, PUBLIC            :: l_fixed_step = .FALSE.
+  INTEGER, PUBLIC            :: nfsteps = 1
+  ! ... number of kpp control PARAMETERs
+  INTEGER, PARAMETER, PUBLIC :: nkppctrl = 20
+  !
+  INTEGER, DIMENSION(nkppctrl), PUBLIC     :: icntrl = 0
+  REAL(dp), DIMENSION(nkppctrl), PUBLIC     :: rcntrl = 0.0_dp
+  REAL(dp), DIMENSION(nmaxfixsteps), PUBLIC :: t_steps = 0.0_dp
+
+  ! END header MODULE initialize_kpp_ctrl_template
+
+ 
+! Interface Block 
+ 
+  INTERFACE            initialize
+    MODULE PROCEDURE   initialize
+  END INTERFACE        initialize
+ 
+  INTERFACE            integrate
+    MODULE PROCEDURE   integrate
+  END INTERFACE        integrate
+ 
+  INTERFACE            fun
+    MODULE PROCEDURE   fun
+  END INTERFACE        fun
+ 
+  INTERFACE            kppsolve
+    MODULE PROCEDURE   kppsolve
+  END INTERFACE        kppsolve
+ 
+  INTERFACE            jac_sp
+    MODULE PROCEDURE   jac_sp
+  END INTERFACE        jac_sp
+ 
+  INTERFACE            k_arr
+    MODULE PROCEDURE   k_arr
+  END INTERFACE        k_arr
+ 
+  INTERFACE            update_rconst
+    MODULE PROCEDURE   update_rconst
+  END INTERFACE        update_rconst
+ 
+  INTERFACE            arr2
+    MODULE PROCEDURE   arr2
+  END INTERFACE        arr2
+ 
+  INTERFACE            initialize_kpp_ctrl
+    MODULE PROCEDURE   initialize_kpp_ctrl
+  END INTERFACE        initialize_kpp_ctrl
+ 
+  INTERFACE            error_output
+    MODULE PROCEDURE   error_output
+  END INTERFACE        error_output
+ 
+  INTERFACE            wscal
+    MODULE PROCEDURE   wscal
+  END INTERFACE        wscal
+ 
+!INTERFACE not working  INTERFACE            waxpy
+!INTERFACE not working    MODULE PROCEDURE   waxpy
+!INTERFACE not working  END INTERFACE        waxpy
+ 
+  INTERFACE            rosenbrock
+    MODULE PROCEDURE   rosenbrock
+  END INTERFACE        rosenbrock
+ 
+  INTERFACE            funtemplate
+    MODULE PROCEDURE   funtemplate
+  END INTERFACE        funtemplate
+ 
+  INTERFACE            jactemplate
+    MODULE PROCEDURE   jactemplate
+  END INTERFACE        jactemplate
+ 
+  INTERFACE            kppdecomp
+    MODULE PROCEDURE   kppdecomp
+  END INTERFACE        kppdecomp
+ 
+  INTERFACE            chem_gasphase_integrate
+    MODULE PROCEDURE   chem_gasphase_integrate
+  END INTERFACE        chem_gasphase_integrate
+ 
+ 
+ CONTAINS
+ 
+SUBROUTINE initialize()
+
+
+  INTEGER         :: j, k
+
+  INTEGER :: i
+  REAL(kind=dp):: x
+  k = is
+  cfactor = 1.000000e+00_dp
+
+  x = (0.) * cfactor
+  DO i = 1 , nvar
+  ENDDO
+
+  x = (0.) * cfactor
+  DO i = 1 , nfix
+    fix(i) = x
+  ENDDO
+
+! constant rate coefficients
+! END constant rate coefficients
+
+! INLINED initializations
+
+! End INLINED initializations
+
+      
+END SUBROUTINE initialize
+ 
+SUBROUTINE integrate( tin, tout, &
+  icntrl_u, rcntrl_u, istatus_u, rstatus_u, ierr_u)
+
+
+   REAL(kind=dp), INTENT(IN):: tin  ! start time
+   REAL(kind=dp), INTENT(IN):: tout ! END time
+   ! OPTIONAL input PARAMETERs and statistics
+   INTEGER,      INTENT(IN), OPTIONAL :: icntrl_u(20)
+   REAL(kind=dp), INTENT(IN), OPTIONAL :: rcntrl_u(20)
+   INTEGER,      INTENT(OUT), OPTIONAL :: istatus_u(20)
+   REAL(kind=dp), INTENT(OUT), OPTIONAL :: rstatus_u(20)
+   INTEGER,      INTENT(OUT), OPTIONAL :: ierr_u
+
+   REAL(kind=dp):: rcntrl(20), rstatus(20)
+   INTEGER       :: icntrl(20), istatus(20), ierr
+
+   INTEGER, SAVE :: ntotal = 0
+
+   icntrl(:) = 0
+   rcntrl(:) = 0.0_dp
+   istatus(:) = 0
+   rstatus(:) = 0.0_dp
+
+    !~~~> fine-tune the integrator:
+   icntrl(1) = 0      ! 0 - non- autonomous, 1 - autonomous
+   icntrl(2) = 0      ! 0 - vector tolerances, 1 - scalars
+
+   ! IF OPTIONAL PARAMETERs are given, and IF they are >0, 
+   ! THEN they overwrite default settings. 
+   IF (PRESENT(icntrl_u))THEN
+     WHERE(icntrl_u(:)> 0)icntrl(:) = icntrl_u(:)
+   ENDIF
+   IF (PRESENT(rcntrl_u))THEN
+     WHERE(rcntrl_u(:)> 0)rcntrl(:) = rcntrl_u(:)
+   ENDIF
+
+
+   CALL rosenbrock(nvar, var, tin, tout,  &
+         atol, rtol,               &
+         rcntrl, icntrl, rstatus, istatus, ierr)
+
+   !~~~> debug option: show no of steps
+   ! ntotal = ntotal + istatus(nstp)
+   ! PRINT*,'NSTEPS=',ISTATUS(Nstp),' (',Ntotal,')','  O3=',VAR(ind_O3)
+
+   stepmin = rstatus(nhexit)
+   ! IF OPTIONAL PARAMETERs are given for output they 
+   ! are updated with the RETURN information
+   IF (PRESENT(istatus_u))istatus_u(:) = istatus(:)
+   IF (PRESENT(rstatus_u))rstatus_u(:) = rstatus(:)
+   IF (PRESENT(ierr_u))  ierr_u       = ierr
+
+END SUBROUTINE integrate
+ 
+SUBROUTINE fun(v, f, rct, vdot)
+
+! V - Concentrations of variable species (local)
+  REAL(kind=dp):: v(nvar)
+! F - Concentrations of fixed species (local)
+  REAL(kind=dp):: f(nfix)
+! RCT - Rate constants (local)
+  REAL(kind=dp):: rct(nreact)
+! Vdot - Time derivative of variable species concentrations
+  REAL(kind=dp):: vdot(nvar)
+
+
+! Computation of equation rates
+
+! Aggregate function
+  vdot(1) = 0
+  vdot(2) = 0
+      
+END SUBROUTINE fun
+ 
+SUBROUTINE kppsolve(jvs, x)
+
+! JVS - sparse Jacobian of variables
+  REAL(kind=dp):: jvs(lu_nonzero)
+! X - Vector for variables
+  REAL(kind=dp):: x(nvar)
+
+  x(2) = x(2) / jvs(2)
+  x(1) = x(1) / jvs(1)
+      
+END SUBROUTINE kppsolve
+ 
+SUBROUTINE jac_sp(v, f, rct, jvs)
+
+! V - Concentrations of variable species (local)
+  REAL(kind=dp):: v(nvar)
+! F - Concentrations of fixed species (local)
+  REAL(kind=dp):: f(nfix)
+! RCT - Rate constants (local)
+  REAL(kind=dp):: rct(nreact)
+! JVS - sparse Jacobian of variables
+  REAL(kind=dp):: jvs(lu_nonzero)
+
+
+! Local variables
+! B - Temporary array
+  REAL(kind=dp):: b(2)
+
+! B(1) = dA(1)/dV(1)
+  b(1) = rct(1)
+! B(2) = dA(2)/dV(2)
+  b(2) = rct(2)
+
+! Construct the Jacobian terms from B's
+! JVS(1) = Jac_FULL(1,1)
+  jvs(1) = 0
+! JVS(2) = Jac_FULL(2,2)
+  jvs(2) = 0
+      
+END SUBROUTINE jac_sp
+ 
+  elemental REAL(kind=dp)FUNCTION k_arr (k_298, tdep, temp)
+    ! arrhenius FUNCTION
+
+    REAL,    INTENT(IN):: k_298 ! k at t = 298.15k
+    REAL,    INTENT(IN):: tdep  ! temperature dependence
+    REAL(kind=dp), INTENT(IN):: temp  ! temperature
+
+    intrinsic exp
+
+    k_arr = k_298 * exp(tdep* (1._dp/temp- 3.3540e-3_dp))! 1/298.15=3.3540e-3
+
+  END FUNCTION k_arr
+ 
+SUBROUTINE update_rconst()
+ INTEGER         :: k
+
+  k = is
+
+! Begin INLINED RCONST
+
+
+! End INLINED RCONST
+
+  rconst(1) = (1.0_dp)
+  rconst(2) = (1.0_dp)
+      
+END SUBROUTINE update_rconst
+ 
+!  END FUNCTION ARR2
+REAL(kind=dp)FUNCTION arr2( a0, b0, temp)
+    REAL(kind=dp):: temp
+    REAL(kind=dp):: a0, b0
+    arr2 = a0 * exp( - b0 / temp)
+END FUNCTION arr2
+ 
+SUBROUTINE initialize_kpp_ctrl(status)
+
+
+  ! i/o
+  INTEGER,         INTENT(OUT):: status
+
+  ! local
+  REAL(dp):: tsum
+  INTEGER  :: i
+
+  ! check fixed time steps
+  tsum = 0.0_dp
+  DO i=1, nmaxfixsteps
+     IF (t_steps(i)< tiny(0.0_dp))exit
+     tsum = tsum + t_steps(i)
+  ENDDO
+
+  nfsteps = i- 1
+
+  l_fixed_step = (nfsteps > 0).and.((tsum - 1.0)< tiny(0.0_dp))
+
+  IF (l_vector)THEN
+     WRITE(*,*) ' MODE             : VECTOR (LENGTH=',VL_DIM,')'
+  ELSE
+     WRITE(*,*) ' MODE             : SCALAR'
+  ENDIF
+  !
+  WRITE(*,*) ' DE-INDEXING MODE :',I_LU_DI
+  !
+  WRITE(*,*) ' ICNTRL           : ',icntrl
+  WRITE(*,*) ' RCNTRL           : ',rcntrl
+  !
+  ! note: this is ONLY meaningful for vectorized (kp4)rosenbrock- methods
+  IF (l_vector)THEN
+     IF (l_fixed_step)THEN
+        WRITE(*,*) ' TIME STEPS       : FIXED (',t_steps(1:nfsteps),')'
+     ELSE
+        WRITE(*,*) ' TIME STEPS       : AUTOMATIC'
+     ENDIF
+  ELSE
+     WRITE(*,*) ' TIME STEPS       : AUTOMATIC '//&
+          &'(t_steps (CTRL_KPP) ignored in SCALAR MODE)'
+  ENDIF
+  ! mz_pj_20070531- 
+
+  status = 0
+
+
+END SUBROUTINE initialize_kpp_ctrl
+ 
+SUBROUTINE error_output(c, ierr, pe)
+
+
+  INTEGER, INTENT(IN):: ierr
+  INTEGER, INTENT(IN):: pe
+  REAL(dp), DIMENSION(:), INTENT(IN):: c
+
+  write(6,*) 'ERROR in chem_gasphase_mod ',ierr,C(1)
+
+
+END SUBROUTINE error_output
+ 
+      SUBROUTINE wscal(n, alpha, x, incx)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+!     constant times a vector: x(1:N) <- Alpha*x(1:N) 
+!     only for incX=incY=1
+!     after BLAS
+!     replace this by the function from the optimized BLAS implementation:
+!         CALL SSCAL(N,Alpha,X,1) or  CALL DSCAL(N,Alpha,X,1)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+
+      INTEGER  :: i, incx, m, mp1, n
+      REAL(kind=dp) :: x(n), alpha
+      REAL(kind=dp), PARAMETER  :: zero=0.0_dp, one=1.0_dp
+
+      IF (alpha .eq. one)RETURN
+      IF (n .le. 0)RETURN
+
+      m = mod(n, 5)
+      IF ( m .ne. 0)THEN
+        IF (alpha .eq. (- one))THEN
+          DO i = 1, m
+            x(i) = - x(i)
+          ENDDO
+        ELSEIF (alpha .eq. zero)THEN
+          DO i = 1, m
+            x(i) = zero
+          ENDDO
+        ELSE
+          DO i = 1, m
+            x(i) = alpha* x(i)
+          ENDDO
+        ENDIF
+        IF ( n .lt. 5)RETURN
+      ENDIF
+      mp1 = m + 1
+      IF (alpha .eq. (- one))THEN
+        DO i = mp1, n, 5
+          x(i)   = - x(i)
+          x(i + 1) = - x(i + 1)
+          x(i + 2) = - x(i + 2)
+          x(i + 3) = - x(i + 3)
+          x(i + 4) = - x(i + 4)
+        ENDDO
+      ELSEIF (alpha .eq. zero)THEN
+        DO i = mp1, n, 5
+          x(i)   = zero
+          x(i + 1) = zero
+          x(i + 2) = zero
+          x(i + 3) = zero
+          x(i + 4) = zero
+        ENDDO
+      ELSE
+        DO i = mp1, n, 5
+          x(i)   = alpha* x(i)
+          x(i + 1) = alpha* x(i + 1)
+          x(i + 2) = alpha* x(i + 2)
+          x(i + 3) = alpha* x(i + 3)
+          x(i + 4) = alpha* x(i + 4)
+        ENDDO
+      ENDIF
+
+      END SUBROUTINE wscal
+ 
+      SUBROUTINE waxpy(n, alpha, x, incx, y, incy)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+!     constant times a vector plus a vector: y <- y + Alpha*x
+!     only for incX=incY=1
+!     after BLAS
+!     replace this by the function from the optimized BLAS implementation:
+!         CALL SAXPY(N,Alpha,X,1,Y,1) or  CALL DAXPY(N,Alpha,X,1,Y,1)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+
+      INTEGER  :: i, incx, incy, m, mp1, n
+      REAL(kind=dp):: x(n), y(n), alpha
+      REAL(kind=dp), PARAMETER :: zero = 0.0_dp
+
+      IF (alpha .eq. zero)RETURN
+      IF (n .le. 0)RETURN
+
+      m = mod(n, 4)
+      IF ( m .ne. 0)THEN
+        DO i = 1, m
+          y(i) = y(i) + alpha* x(i)
+        ENDDO
+        IF ( n .lt. 4)RETURN
+      ENDIF
+      mp1 = m + 1
+      DO i = mp1, n, 4
+        y(i) = y(i) + alpha* x(i)
+        y(i + 1) = y(i + 1) + alpha* x(i + 1)
+        y(i + 2) = y(i + 2) + alpha* x(i + 2)
+        y(i + 3) = y(i + 3) + alpha* x(i + 3)
+      ENDDO
+      
+      END SUBROUTINE waxpy
+ 
+SUBROUTINE rosenbrock(n, y, tstart, tend, &
+           abstol, reltol,             &
+           rcntrl, icntrl, rstatus, istatus, ierr)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!    Solves the system y'=F(t,y) using a Rosenbrock method defined by:
+!
+!     G = 1/(H*gamma(1)) - Jac(t0,Y0)
+!     T_i = t0 + Alpha(i)*H
+!     Y_i = Y0 + \sum_{j=1}^{i-1} A(i,j)*K_j
+!     G *K_i = Fun( T_i,Y_i)+ \sum_{j=1}^S C(i,j)/H *K_j +
+!         gamma(i)*dF/dT(t0,Y0)
+!     Y1 = Y0 + \sum_{j=1}^S M(j)*K_j
+!
+!    For details on Rosenbrock methods and their implementation consult:
+!      E. Hairer and G. Wanner
+!      "Solving ODEs II. Stiff and differential-algebraic problems".
+!      Springer series in computational mathematics,Springer-Verlag,1996.
+!    The codes contained in the book inspired this implementation.
+!
+!    (C)  Adrian Sandu,August 2004
+!    Virginia Polytechnic Institute and State University
+!    Contact: sandu@cs.vt.edu
+!    Revised by Philipp Miehe and Adrian Sandu,May 2006                  
+!    This implementation is part of KPP - the Kinetic PreProcessor
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!~~~>   input arguments:
+!
+!-     y(n)  = vector of initial conditions (at t=tstart)
+!-    [tstart, tend]  = time range of integration
+!     (if Tstart>Tend the integration is performed backwards in time)
+!-    reltol, abstol = user precribed accuracy
+!- SUBROUTINE  fun( t, y, ydot) = ode FUNCTION, 
+!                       returns Ydot = Y' = F(T,Y)
+!- SUBROUTINE  jac( t, y, jcb) = jacobian of the ode FUNCTION, 
+!                       returns Jcb = dFun/dY
+!-    icntrl(1:20)  = INTEGER inputs PARAMETERs
+!-    rcntrl(1:20)  = REAL inputs PARAMETERs
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!~~~>     output arguments:
+!
+!-    y(n)  - > vector of final states (at t- >tend)
+!-    istatus(1:20) - > INTEGER output PARAMETERs
+!-    rstatus(1:20) - > REAL output PARAMETERs
+!-    ierr            - > job status upon RETURN
+!                        success (positive value) or
+!                        failure (negative value)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!~~~>     input PARAMETERs:
+!
+!    Note: For input parameters equal to zero the default values of the
+!       corresponding variables are used.
+!
+!    ICNTRL(1) = 1: F = F(y)   Independent of T (AUTONOMOUS)
+!              = 0: F = F(t,y) Depends on T (NON-AUTONOMOUS)
+!
+!    ICNTRL(2) = 0: AbsTol,RelTol are N-dimensional vectors
+!              = 1: AbsTol,RelTol are scalars
+!
+!    ICNTRL(3)  -> selection of a particular Rosenbrock method
+!        = 0 :    Rodas3 (default)
+!        = 1 :    Ros2
+!        = 2 :    Ros3
+!        = 3 :    Ros4
+!        = 4 :    Rodas3
+!        = 5 :    Rodas4
+!
+!    ICNTRL(4)  -> maximum number of integration steps
+!        For ICNTRL(4) =0) the default value of 100000 is used
+!
+!    RCNTRL(1)  -> Hmin,lower bound for the integration step size
+!          It is strongly recommended to keep Hmin = ZERO
+!    RCNTRL(2)  -> Hmax,upper bound for the integration step size
+!    RCNTRL(3)  -> Hstart,starting value for the integration step size
+!
+!    RCNTRL(4)  -> FacMin,lower bound on step decrease factor (default=0.2)
+!    RCNTRL(5)  -> FacMax,upper bound on step increase factor (default=6)
+!    RCNTRL(6)  -> FacRej,step decrease factor after multiple rejections
+!                          (default=0.1)
+!    RCNTRL(7)  -> FacSafe,by which the new step is slightly smaller
+!         than the predicted value  (default=0.9)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!
+!    OUTPUT ARGUMENTS:
+!    -----------------
+!
+!    T           -> T value for which the solution has been computed
+!                     (after successful return T=Tend).
+!
+!    Y(N)        -> Numerical solution at T
+!
+!    IDID        -> Reports on successfulness upon return:
+!                    = 1 for success
+!                    < 0 for error (value equals error code)
+!
+!    ISTATUS(1)  -> No. of function calls
+!    ISTATUS(2)  -> No. of jacobian calls
+!    ISTATUS(3)  -> No. of steps
+!    ISTATUS(4)  -> No. of accepted steps
+!    ISTATUS(5)  -> No. of rejected steps (except at very beginning)
+!    ISTATUS(6)  -> No. of LU decompositions
+!    ISTATUS(7)  -> No. of forward/backward substitutions
+!    ISTATUS(8)  -> No. of singular matrix decompositions
+!
+!    RSTATUS(1)  -> Texit,the time corresponding to the
+!                     computed Y upon return
+!    RSTATUS(2)  -> Hexit,last accepted step before exit
+!    RSTATUS(3)  -> Hnew,last predicted step (not yet taken)
+!                   For multiple restarts,use Hnew as Hstart 
+!                     in the subsequent run
+!
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~>  arguments
+   INTEGER,      INTENT(IN)  :: n
+   REAL(kind=dp), INTENT(INOUT):: y(n)
+   REAL(kind=dp), INTENT(IN)  :: tstart, tend
+   REAL(kind=dp), INTENT(IN)  :: abstol(n), reltol(n)
+   INTEGER,      INTENT(IN)  :: icntrl(20)
+   REAL(kind=dp), INTENT(IN)  :: rcntrl(20)
+   INTEGER,      INTENT(INOUT):: istatus(20)
+   REAL(kind=dp), INTENT(INOUT):: rstatus(20)
+   INTEGER, INTENT(OUT) :: ierr
+!~~~>  PARAMETERs of the rosenbrock method, up to 6 stages
+   INTEGER ::  ros_s, rosmethod
+   INTEGER, PARAMETER :: rs2=1, rs3=2, rs4=3, rd3=4, rd4=5, rg3=6
+   REAL(kind=dp):: ros_a(15), ros_c(15), ros_m(6), ros_e(6), &
+                    ros_alpha(6), ros_gamma(6), ros_elo
+   LOGICAL :: ros_newf(6)
+   CHARACTER(len=12):: ros_name
+!~~~>  local variables
+   REAL(kind=dp):: roundoff, facmin, facmax, facrej, facsafe
+   REAL(kind=dp):: hmin, hmax, hstart
+   REAL(kind=dp):: texit
+   INTEGER       :: i, uplimtol, max_no_steps
+   LOGICAL       :: autonomous, vectortol
+!~~~>   PARAMETERs
+   REAL(kind=dp), PARAMETER :: zero = 0.0_dp, one  = 1.0_dp
+   REAL(kind=dp), PARAMETER :: deltamin = 1.0e-5_dp
+
+!~~~>  initialize statistics
+   istatus(1:8) = 0
+   rstatus(1:3) = zero
+
+!~~~>  autonomous or time dependent ode. default is time dependent.
+   autonomous = .not.(icntrl(1) == 0)
+
+!~~~>  for scalar tolerances (icntrl(2).ne.0) the code uses abstol(1)and reltol(1)
+!   For Vector tolerances (ICNTRL(2) == 0) the code uses AbsTol(1:N) and RelTol(1:N)
+   IF (icntrl(2) == 0)THEN
+      vectortol = .TRUE.
+      uplimtol  = n
+   ELSE
+      vectortol = .FALSE.
+      uplimtol  = 1
+   ENDIF
+
+!~~~>   initialize the particular rosenbrock method selected
+   select CASE (icntrl(3))
+     CASE (1)
+       CALL ros2
+     CASE (2)
+       CALL ros3
+     CASE (3)
+       CALL ros4
+     CASE (0, 4)
+       CALL rodas3
+     CASE (5)
+       CALL rodas4
+     CASE (6)
+       CALL rang3
+     CASE default
+       PRINT *,'Unknown Rosenbrock method: ICNTRL(3) =',ICNTRL(3) 
+       CALL ros_errormsg(- 2, tstart, zero, ierr)
+       RETURN
+   END select
+
+!~~~>   the maximum number of steps admitted
+   IF (icntrl(4) == 0)THEN
+      max_no_steps = 200000
+   ELSEIF (icntrl(4)> 0)THEN
+      max_no_steps=icntrl(4)
+   ELSE
+      PRINT *,'User-selected max no. of steps: ICNTRL(4) =',ICNTRL(4)
+      CALL ros_errormsg(- 1, tstart, zero, ierr)
+      RETURN
+   ENDIF
+
+!~~~>  unit roundoff (1+ roundoff>1)
+   roundoff = epsilon(one)
+
+!~~~>  lower bound on the step size: (positive value)
+   IF (rcntrl(1) == zero)THEN
+      hmin = zero
+   ELSEIF (rcntrl(1)> zero)THEN
+      hmin = rcntrl(1)
+   ELSE
+      PRINT *,'User-selected Hmin: RCNTRL(1) =',RCNTRL(1)
+      CALL ros_errormsg(- 3, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  upper bound on the step size: (positive value)
+   IF (rcntrl(2) == zero)THEN
+      hmax = abs(tend-tstart)
+   ELSEIF (rcntrl(2)> zero)THEN
+      hmax = min(abs(rcntrl(2)), abs(tend-tstart))
+   ELSE
+      PRINT *,'User-selected Hmax: RCNTRL(2) =',RCNTRL(2)
+      CALL ros_errormsg(- 3, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  starting step size: (positive value)
+   IF (rcntrl(3) == zero)THEN
+      hstart = max(hmin, deltamin)
+   ELSEIF (rcntrl(3)> zero)THEN
+      hstart = min(abs(rcntrl(3)), abs(tend-tstart))
+   ELSE
+      PRINT *,'User-selected Hstart: RCNTRL(3) =',RCNTRL(3)
+      CALL ros_errormsg(- 3, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  step size can be changed s.t.  facmin < hnew/hold < facmax
+   IF (rcntrl(4) == zero)THEN
+      facmin = 0.2_dp
+   ELSEIF (rcntrl(4)> zero)THEN
+      facmin = rcntrl(4)
+   ELSE
+      PRINT *,'User-selected FacMin: RCNTRL(4) =',RCNTRL(4)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+   IF (rcntrl(5) == zero)THEN
+      facmax = 6.0_dp
+   ELSEIF (rcntrl(5)> zero)THEN
+      facmax = rcntrl(5)
+   ELSE
+      PRINT *,'User-selected FacMax: RCNTRL(5) =',RCNTRL(5)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>   facrej: factor to decrease step after 2 succesive rejections
+   IF (rcntrl(6) == zero)THEN
+      facrej = 0.1_dp
+   ELSEIF (rcntrl(6)> zero)THEN
+      facrej = rcntrl(6)
+   ELSE
+      PRINT *,'User-selected FacRej: RCNTRL(6) =',RCNTRL(6)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>   facsafe: safety factor in the computation of new step size
+   IF (rcntrl(7) == zero)THEN
+      facsafe = 0.9_dp
+   ELSEIF (rcntrl(7)> zero)THEN
+      facsafe = rcntrl(7)
+   ELSE
+      PRINT *,'User-selected FacSafe: RCNTRL(7) =',RCNTRL(7)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  check IF tolerances are reasonable
+    DO i=1, uplimtol
+      IF ((abstol(i)<= zero).or. (reltol(i)<= 10.0_dp* roundoff)&
+         .or. (reltol(i)>= 1.0_dp))THEN
+        PRINT *,' AbsTol(',i,') = ',AbsTol(i)
+        PRINT *,' RelTol(',i,') = ',RelTol(i)
+        CALL ros_errormsg(- 5, tstart, zero, ierr)
+        RETURN
+      ENDIF
+    ENDDO
+
+
+!~~~>  CALL rosenbrock method
+   CALL ros_integrator(y, tstart, tend, texit,  &
+        abstol, reltol,                         &
+!  Integration parameters
+        autonomous, vectortol, max_no_steps,    &
+        roundoff, hmin, hmax, hstart,           &
+        facmin, facmax, facrej, facsafe,        &
+!  Error indicator
+        ierr)
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+CONTAINS !  SUBROUTINEs internal to rosenbrock
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
+ SUBROUTINE ros_errormsg(code, t, h, ierr)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
+!    Handles all error messages
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
+  
+   REAL(kind=dp), INTENT(IN):: t, h
+   INTEGER, INTENT(IN) :: code
+   INTEGER, INTENT(OUT):: ierr
+   
+   ierr = code
+   print * , &
+     'Forced exit from Rosenbrock due to the following error:' 
+     
+   select CASE (code)
+    CASE (- 1)  
+      PRINT *,'--> Improper value for maximal no of steps'
+    CASE (- 2)  
+      PRINT *,'--> Selected Rosenbrock method not implemented'
+    CASE (- 3)  
+      PRINT *,'--> Hmin/Hmax/Hstart must be positive'
+    CASE (- 4)  
+      PRINT *,'--> FacMin/FacMax/FacRej must be positive'
+    CASE (- 5)
+      PRINT *,'--> Improper tolerance values'
+    CASE (- 6)
+      PRINT *,'--> No of steps exceeds maximum bound'
+    CASE (- 7)
+      PRINT *,'--> Step size too small: T + 10*H = T',&
+            ' or H < Roundoff'
+    CASE (- 8)  
+      PRINT *,'--> Matrix is repeatedly singular'
+    CASE default
+      PRINT *,'Unknown Error code: ',Code
+   END select
+   
+   print * , "t=", t, "and h=", h
+     
+ END SUBROUTINE ros_errormsg
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ SUBROUTINE ros_integrator (y, tstart, tend, t, &
+        abstol, reltol,                         &
+!~~~> integration PARAMETERs
+        autonomous, vectortol, max_no_steps,    &
+        roundoff, hmin, hmax, hstart,           &
+        facmin, facmax, facrej, facsafe,        &
+!~~~> error indicator
+        ierr)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!   Template for the implementation of a generic Rosenbrock method
+!      defined by ros_S (no of stages)
+!      and its coefficients ros_{A,C,M,E,Alpha,Gamma}
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~> input: the initial condition at tstart; output: the solution at t
+   REAL(kind=dp), INTENT(INOUT):: y(n)
+!~~~> input: integration interval
+   REAL(kind=dp), INTENT(IN):: tstart, tend
+!~~~> output: time at which the solution is RETURNed (t=tendIF success)
+   REAL(kind=dp), INTENT(OUT)::  t
+!~~~> input: tolerances
+   REAL(kind=dp), INTENT(IN)::  abstol(n), reltol(n)
+!~~~> input: integration PARAMETERs
+   LOGICAL, INTENT(IN):: autonomous, vectortol
+   REAL(kind=dp), INTENT(IN):: hstart, hmin, hmax
+   INTEGER, INTENT(IN):: max_no_steps
+   REAL(kind=dp), INTENT(IN):: roundoff, facmin, facmax, facrej, facsafe
+!~~~> output: error indicator
+   INTEGER, INTENT(OUT):: ierr
+! ~~~~ Local variables
+   REAL(kind=dp):: ynew(n), fcn0(n), fcn(n)
+   REAL(kind=dp):: k(n* ros_s), dfdt(n)
+#ifdef full_algebra    
+   REAL(kind=dp):: jac0(n, n), ghimj(n, n)
+#else
+   REAL(kind=dp):: jac0(lu_nonzero), ghimj(lu_nonzero)
+#endif
+   REAL(kind=dp):: h, hnew, hc, hg, fac, tau
+   REAL(kind=dp):: err, yerr(n)
+   INTEGER :: pivot(n), direction, ioffset, j, istage
+   LOGICAL :: rejectlasth, rejectmoreh, singular
+!~~~>  local PARAMETERs
+   REAL(kind=dp), PARAMETER :: zero = 0.0_dp, one  = 1.0_dp
+   REAL(kind=dp), PARAMETER :: deltamin = 1.0e-5_dp
+!~~~>  locally called FUNCTIONs
+!    REAL(kind=dp) WLAMCH
+!    EXTERNAL WLAMCH
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~>  initial preparations
+   t = tstart
+   rstatus(nhexit) = zero
+   h = min( max(abs(hmin), abs(hstart)), abs(hmax))
+   IF (abs(h)<= 10.0_dp* roundoff)h = deltamin
+
+   IF (tend  >=  tstart)THEN
+     direction = + 1
+   ELSE
+     direction = - 1
+   ENDIF
+   h = direction* h
+
+   rejectlasth=.FALSE.
+   rejectmoreh=.FALSE.
+
+!~~~> time loop begins below
+
+timeloop: DO WHILE((direction > 0).and.((t- tend) + roundoff <= zero)&
+       .or. (direction < 0).and.((tend-t) + roundoff <= zero))
+
+   IF (istatus(nstp)> max_no_steps)THEN  ! too many steps
+      CALL ros_errormsg(- 6, t, h, ierr)
+      RETURN
+   ENDIF
+   IF (((t+ 0.1_dp* h) == t).or.(h <= roundoff))THEN  ! step size too small
+      CALL ros_errormsg(- 7, t, h, ierr)
+      RETURN
+   ENDIF
+
+!~~~>  limit h IF necessary to avoid going beyond tend
+   h = min(h, abs(tend-t))
+
+!~~~>   compute the FUNCTION at current time
+   CALL funtemplate(t, y, fcn0)
+   istatus(nfun) = istatus(nfun) + 1
+
+!~~~>  compute the FUNCTION derivative with respect to t
+   IF (.not.autonomous)THEN
+      CALL ros_funtimederivative(t, roundoff, y, &
+                fcn0, dfdt)
+   ENDIF
+
+!~~~>   compute the jacobian at current time
+   CALL jactemplate(t, y, jac0)
+   istatus(njac) = istatus(njac) + 1
+
+!~~~>  repeat step calculation until current step accepted
+untilaccepted: do
+
+   CALL ros_preparematrix(h, direction, ros_gamma(1), &
+          jac0, ghimj, pivot, singular)
+   IF (singular)THEN ! more than 5 consecutive failed decompositions
+       CALL ros_errormsg(- 8, t, h, ierr)
+       RETURN
+   ENDIF
+
+!~~~>   compute the stages
+stage: DO istage = 1, ros_s
+
+      ! current istage offset. current istage vector is k(ioffset+ 1:ioffset+ n)
+       ioffset = n* (istage-1)
+
+      ! for the 1st istage the FUNCTION has been computed previously
+       IF (istage == 1)THEN
+         !slim: CALL wcopy(n, fcn0, 1, fcn, 1)
+       fcn(1:n) = fcn0(1:n)
+      ! istage>1 and a new FUNCTION evaluation is needed at the current istage
+       ELSEIF(ros_newf(istage))THEN
+         !slim: CALL wcopy(n, y, 1, ynew, 1)
+       ynew(1:n) = y(1:n)
+         DO j = 1, istage-1
+           CALL waxpy(n, ros_a((istage-1) * (istage-2) /2+ j), &
+            k(n* (j- 1) + 1), 1, ynew, 1)
+         ENDDO
+         tau = t + ros_alpha(istage) * direction* h
+         CALL funtemplate(tau, ynew, fcn)
+         istatus(nfun) = istatus(nfun) + 1
+       ENDIF ! IF istage == 1 ELSEIF ros_newf(istage)
+       !slim: CALL wcopy(n, fcn, 1, k(ioffset+ 1), 1)
+       k(ioffset+ 1:ioffset+ n) = fcn(1:n)
+       DO j = 1, istage-1
+         hc = ros_c((istage-1) * (istage-2) /2+ j) /(direction* h)
+         CALL waxpy(n, hc, k(n* (j- 1) + 1), 1, k(ioffset+ 1), 1)
+       ENDDO
+       IF ((.not. autonomous).and.(ros_gamma(istage).ne.zero))THEN
+         hg = direction* h* ros_gamma(istage)
+         CALL waxpy(n, hg, dfdt, 1, k(ioffset+ 1), 1)
+       ENDIF
+       CALL ros_solve(ghimj, pivot, k(ioffset+ 1))
+
+   END DO stage
+
+
+!~~~>  compute the new solution
+   !slim: CALL wcopy(n, y, 1, ynew, 1)
+   ynew(1:n) = y(1:n)
+   DO j=1, ros_s
+         CALL waxpy(n, ros_m(j), k(n* (j- 1) + 1), 1, ynew, 1)
+   ENDDO
+
+!~~~>  compute the error estimation
+   !slim: CALL wscal(n, zero, yerr, 1)
+   yerr(1:n) = zero
+   DO j=1, ros_s
+        CALL waxpy(n, ros_e(j), k(n* (j- 1) + 1), 1, yerr, 1)
+   ENDDO
+   err = ros_errornorm(y, ynew, yerr, abstol, reltol, vectortol)
+
+!~~~> new step size is bounded by facmin <= hnew/h <= facmax
+   fac  = min(facmax, max(facmin, facsafe/err** (one/ros_elo)))
+   hnew = h* fac
+
+!~~~>  check the error magnitude and adjust step size
+   istatus(nstp) = istatus(nstp) + 1
+   IF ((err <= one).or.(h <= hmin))THEN  !~~~> accept step
+      istatus(nacc) = istatus(nacc) + 1
+      !slim: CALL wcopy(n, ynew, 1, y, 1)
+      y(1:n) = ynew(1:n)
+      t = t + direction* h
+      hnew = max(hmin, min(hnew, hmax))
+      IF (rejectlasth)THEN  ! no step size increase after a rejected step
+         hnew = min(hnew, h)
+      ENDIF
+      rstatus(nhexit) = h
+      rstatus(nhnew) = hnew
+      rstatus(ntexit) = t
+      rejectlasth = .FALSE.
+      rejectmoreh = .FALSE.
+      h = hnew
+      exit untilaccepted ! exit the loop: WHILE step not accepted
+   ELSE           !~~~> reject step
+      IF (rejectmoreh)THEN
+         hnew = h* facrej
+      ENDIF
+      rejectmoreh = rejectlasth
+      rejectlasth = .TRUE.
+      h = hnew
+      IF (istatus(nacc)>= 1) istatus(nrej) = istatus(nrej) + 1
+   ENDIF ! err <= 1
+
+   END DO untilaccepted
+
+   END DO timeloop
+
+!~~~> succesful exit
+   ierr = 1  !~~~> the integration was successful
+
+  END SUBROUTINE ros_integrator
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  REAL(kind=dp)FUNCTION ros_errornorm(y, ynew, yerr, &
+                               abstol, reltol, vectortol)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> computes the "scaled norm" of the error vector yerr
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+! Input arguments
+   REAL(kind=dp), INTENT(IN):: y(n), ynew(n), &
+          yerr(n), abstol(n), reltol(n)
+   LOGICAL, INTENT(IN)::  vectortol
+! Local variables
+   REAL(kind=dp):: err, scale, ymax
+   INTEGER  :: i
+   REAL(kind=dp), PARAMETER :: zero = 0.0_dp
+
+   err = zero
+   DO i=1, n
+     ymax = max(abs(y(i)), abs(ynew(i)))
+     IF (vectortol)THEN
+       scale = abstol(i) + reltol(i) * ymax
+     ELSE
+       scale = abstol(1) + reltol(1) * ymax
+     ENDIF
+     err = err+ (yerr(i) /scale) ** 2
+   ENDDO
+   err  = sqrt(err/n)
+
+   ros_errornorm = max(err, 1.0d-10)
+
+  END FUNCTION ros_errornorm
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_funtimederivative(t, roundoff, y, &
+                fcn0, dfdt)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> the time partial derivative of the FUNCTION by finite differences
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+!~~~> input arguments
+   REAL(kind=dp), INTENT(IN):: t, roundoff, y(n), fcn0(n)
+!~~~> output arguments
+   REAL(kind=dp), INTENT(OUT):: dfdt(n)
+!~~~> local variables
+   REAL(kind=dp):: delta
+   REAL(kind=dp), PARAMETER :: one = 1.0_dp, deltamin = 1.0e-6_dp
+
+   delta = sqrt(roundoff) * max(deltamin, abs(t))
+   CALL funtemplate(t+ delta, y, dfdt)
+   istatus(nfun) = istatus(nfun) + 1
+   CALL waxpy(n, (- one), fcn0, 1, dfdt, 1)
+   CALL wscal(n, (one/delta), dfdt, 1)
+
+  END SUBROUTINE ros_funtimederivative
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_preparematrix(h, direction, gam, &
+             jac0, ghimj, pivot, singular)
+! --- --- --- --- --- --- --- --- --- --- --- --- ---
+!  Prepares the LHS matrix for stage calculations
+!  1.  Construct Ghimj = 1/(H*ham) - Jac0
+!      "(Gamma H) Inverse Minus Jacobian"
+!  2.  Repeat LU decomposition of Ghimj until successful.
+!       -half the step size if LU decomposition fails and retry
+!       -exit after 5 consecutive fails
+! --- --- --- --- --- --- --- --- --- --- --- --- ---
+
+!~~~> input arguments
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(IN)::  jac0(n, n)
+#else
+   REAL(kind=dp), INTENT(IN)::  jac0(lu_nonzero)
+#endif   
+   REAL(kind=dp), INTENT(IN)::  gam
+   INTEGER, INTENT(IN)::  direction
+!~~~> output arguments
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(OUT):: ghimj(n, n)
+#else
+   REAL(kind=dp), INTENT(OUT):: ghimj(lu_nonzero)
+#endif   
+   LOGICAL, INTENT(OUT)::  singular
+   INTEGER, INTENT(OUT)::  pivot(n)
+!~~~> inout arguments
+   REAL(kind=dp), INTENT(INOUT):: h   ! step size is decreased when lu fails
+!~~~> local variables
+   INTEGER  :: i, ising, nconsecutive
+   REAL(kind=dp):: ghinv
+   REAL(kind=dp), PARAMETER :: one  = 1.0_dp, half = 0.5_dp
+
+   nconsecutive = 0
+   singular = .TRUE.
+
+   DO WHILE (singular)
+
+!~~~>    construct ghimj = 1/(h* gam) - jac0
+#ifdef full_algebra    
+     !slim: CALL wcopy(n* n, jac0, 1, ghimj, 1)
+     !slim: CALL wscal(n* n, (- one), ghimj, 1)
+     ghimj = - jac0
+     ghinv = one/(direction* h* gam)
+     DO i=1, n
+       ghimj(i, i) = ghimj(i, i) + ghinv
+     ENDDO
+#else
+     !slim: CALL wcopy(lu_nonzero, jac0, 1, ghimj, 1)
+     !slim: CALL wscal(lu_nonzero, (- one), ghimj, 1)
+     ghimj(1:lu_nonzero) = - jac0(1:lu_nonzero)
+     ghinv = one/(direction* h* gam)
+     DO i=1, n
+       ghimj(lu_diag(i)) = ghimj(lu_diag(i)) + ghinv
+     ENDDO
+#endif   
+!~~~>    compute lu decomposition
+     CALL ros_decomp( ghimj, pivot, ising)
+     IF (ising == 0)THEN
+!~~~>    IF successful done
+        singular = .FALSE.
+     ELSE ! ising .ne. 0
+!~~~>    IF unsuccessful half the step size; IF 5 consecutive fails THEN RETURN
+        istatus(nsng) = istatus(nsng) + 1
+        nconsecutive = nconsecutive+1
+        singular = .TRUE.
+        PRINT*,'Warning: LU Decomposition returned ISING = ',ISING
+        IF (nconsecutive <= 5)THEN ! less than 5 consecutive failed decompositions
+           h = h* half
+        ELSE  ! more than 5 consecutive failed decompositions
+           RETURN
+        ENDIF  ! nconsecutive
+      ENDIF    ! ising
+
+   END DO ! WHILE singular
+
+  END SUBROUTINE ros_preparematrix
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_decomp( a, pivot, ising)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the LU decomposition
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> inout variables
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(INOUT):: a(n, n)
+#else   
+   REAL(kind=dp), INTENT(INOUT):: a(lu_nonzero)
+#endif
+!~~~> output variables
+   INTEGER, INTENT(OUT):: pivot(n), ising
+
+#ifdef full_algebra    
+   CALL  dgetrf( n, n, a, n, pivot, ising)
+#else   
+   CALL kppdecomp(a, ising)
+   pivot(1) = 1
+#endif
+   istatus(ndec) = istatus(ndec) + 1
+
+  END SUBROUTINE ros_decomp
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_solve( a, pivot, b)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the forward/backward substitution (using pre-computed LU decomposition)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> input variables
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(IN):: a(n, n)
+   INTEGER :: ising
+#else   
+   REAL(kind=dp), INTENT(IN):: a(lu_nonzero)
+#endif
+   INTEGER, INTENT(IN):: pivot(n)
+!~~~> inout variables
+   REAL(kind=dp), INTENT(INOUT):: b(n)
+
+#ifdef full_algebra    
+   CALL  DGETRS( 'N',N ,1,A,N,Pivot,b,N,ISING)
+   IF (info < 0)THEN
+      print* , "error in dgetrs. ising=", ising
+   ENDIF  
+#else   
+   CALL kppsolve( a, b)
+#endif
+
+   istatus(nsol) = istatus(nsol) + 1
+
+  END SUBROUTINE ros_solve
+
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros2
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! --- AN L-STABLE METHOD,2 stages,order 2
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+   double precision g
+
+    g = 1.0_dp + 1.0_dp/sqrt(2.0_dp)
+    rosmethod = rs2
+!~~~> name of the method
+    ros_Name = 'ROS-2'
+!~~~> number of stages
+    ros_s = 2
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+    ros_a(1) = (1.0_dp) /g
+    ros_c(1) = (- 2.0_dp) /g
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+    ros_newf(1) = .TRUE.
+    ros_newf(2) = .TRUE.
+!~~~> m_i = coefficients for new step solution
+    ros_m(1) = (3.0_dp) /(2.0_dp* g)
+    ros_m(2) = (1.0_dp) /(2.0_dp* g)
+! E_i = Coefficients for error estimator
+    ros_e(1) = 1.0_dp/(2.0_dp* g)
+    ros_e(2) = 1.0_dp/(2.0_dp* g)
+!~~~> ros_elo = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus one
+    ros_elo = 2.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+    ros_alpha(1) = 0.0_dp
+    ros_alpha(2) = 1.0_dp
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+    ros_gamma(1) = g
+    ros_gamma(2) = -g
+
+ END SUBROUTINE ros2
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! --- AN L-STABLE METHOD,3 stages,order 3,2 function evaluations
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+   rosmethod = rs3
+!~~~> name of the method
+   ros_Name = 'ROS-3'
+!~~~> number of stages
+   ros_s = 3
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+   ros_a(1) = 1.0_dp
+   ros_a(2) = 1.0_dp
+   ros_a(3) = 0.0_dp
+
+   ros_c(1) = - 0.10156171083877702091975600115545e+01_dp
+   ros_c(2) =  0.40759956452537699824805835358067e+01_dp
+   ros_c(3) =  0.92076794298330791242156818474003e+01_dp
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+   ros_newf(1) = .TRUE.
+   ros_newf(2) = .TRUE.
+   ros_newf(3) = .FALSE.
+!~~~> m_i = coefficients for new step solution
+   ros_m(1) =  0.1e+01_dp
+   ros_m(2) =  0.61697947043828245592553615689730e+01_dp
+   ros_m(3) = - 0.42772256543218573326238373806514_dp
+! E_i = Coefficients for error estimator
+   ros_e(1) =  0.5_dp
+   ros_e(2) = - 0.29079558716805469821718236208017e+01_dp
+   ros_e(3) =  0.22354069897811569627360909276199_dp
+!~~~> ros_elo = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus 1
+   ros_elo = 3.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+   ros_alpha(1) = 0.0_dp
+   ros_alpha(2) = 0.43586652150845899941601945119356_dp
+   ros_alpha(3) = 0.43586652150845899941601945119356_dp
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+   ros_gamma(1) = 0.43586652150845899941601945119356_dp
+   ros_gamma(2) = 0.24291996454816804366592249683314_dp
+   ros_gamma(3) = 0.21851380027664058511513169485832e+01_dp
+
+  END SUBROUTINE ros3
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros4
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     L-STABLE ROSENBROCK METHOD OF ORDER 4,WITH 4 STAGES
+!     L-STABLE EMBEDDED ROSENBROCK METHOD OF ORDER 3
+!
+!      E. HAIRER AND G. WANNER,SOLVING ORDINARY DIFFERENTIAL
+!      EQUATIONS II. STIFF AND DIFFERENTIAL-ALGEBRAIC PROBLEMS.
+!      SPRINGER SERIES IN COMPUTATIONAL MATHEMATICS,
+!      SPRINGER-VERLAG (1990)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+   rosmethod = rs4
+!~~~> name of the method
+   ros_Name = 'ROS-4'
+!~~~> number of stages
+   ros_s = 4
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+   ros_a(1) = 0.2000000000000000e+01_dp
+   ros_a(2) = 0.1867943637803922e+01_dp
+   ros_a(3) = 0.2344449711399156_dp
+   ros_a(4) = ros_a(2)
+   ros_a(5) = ros_a(3)
+   ros_a(6) = 0.0_dp
+
+   ros_c(1) = -0.7137615036412310e+01_dp
+   ros_c(2) = 0.2580708087951457e+01_dp
+   ros_c(3) = 0.6515950076447975_dp
+   ros_c(4) = -0.2137148994382534e+01_dp
+   ros_c(5) = -0.3214669691237626_dp
+   ros_c(6) = -0.6949742501781779_dp
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+   ros_newf(1) = .TRUE.
+   ros_newf(2) = .TRUE.
+   ros_newf(3) = .TRUE.
+   ros_newf(4) = .FALSE.
+!~~~> m_i = coefficients for new step solution
+   ros_m(1) = 0.2255570073418735e+01_dp
+   ros_m(2) = 0.2870493262186792_dp
+   ros_m(3) = 0.4353179431840180_dp
+   ros_m(4) = 0.1093502252409163e+01_dp
+!~~~> e_i  = coefficients for error estimator
+   ros_e(1) = -0.2815431932141155_dp
+   ros_e(2) = -0.7276199124938920e-01_dp
+   ros_e(3) = -0.1082196201495311_dp
+   ros_e(4) = -0.1093502252409163e+01_dp
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus 1
+   ros_elo  = 4.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+   ros_alpha(1) = 0.0_dp
+   ros_alpha(2) = 0.1145640000000000e+01_dp
+   ros_alpha(3) = 0.6552168638155900_dp
+   ros_alpha(4) = ros_alpha(3)
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+   ros_gamma(1) = 0.5728200000000000_dp
+   ros_gamma(2) = -0.1769193891319233e+01_dp
+   ros_gamma(3) = 0.7592633437920482_dp
+   ros_gamma(4) = -0.1049021087100450_dp
+
+  END SUBROUTINE ros4
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE rodas3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! --- A STIFFLY-STABLE METHOD,4 stages,order 3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+   rosmethod = rd3
+!~~~> name of the method
+   ros_Name = 'RODAS-3'
+!~~~> number of stages
+   ros_s = 4
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+   ros_a(1) = 0.0_dp
+   ros_a(2) = 2.0_dp
+   ros_a(3) = 0.0_dp
+   ros_a(4) = 2.0_dp
+   ros_a(5) = 0.0_dp
+   ros_a(6) = 1.0_dp
+
+   ros_c(1) = 4.0_dp
+   ros_c(2) = 1.0_dp
+   ros_c(3) = -1.0_dp
+   ros_c(4) = 1.0_dp
+   ros_c(5) = -1.0_dp
+   ros_c(6) = -(8.0_dp/3.0_dp)
+
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+   ros_newf(1) = .TRUE.
+   ros_newf(2) = .FALSE.
+   ros_newf(3) = .TRUE.
+   ros_newf(4) = .TRUE.
+!~~~> m_i = coefficients for new step solution
+   ros_m(1) = 2.0_dp
+   ros_m(2) = 0.0_dp
+   ros_m(3) = 1.0_dp
+   ros_m(4) = 1.0_dp
+!~~~> e_i  = coefficients for error estimator
+   ros_e(1) = 0.0_dp
+   ros_e(2) = 0.0_dp
+   ros_e(3) = 0.0_dp
+   ros_e(4) = 1.0_dp
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus 1
+   ros_elo  = 3.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+   ros_alpha(1) = 0.0_dp
+   ros_alpha(2) = 0.0_dp
+   ros_alpha(3) = 1.0_dp
+   ros_alpha(4) = 1.0_dp
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+   ros_gamma(1) = 0.5_dp
+   ros_gamma(2) = 1.5_dp
+   ros_gamma(3) = 0.0_dp
+   ros_gamma(4) = 0.0_dp
+
+  END SUBROUTINE rodas3
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE rodas4
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     STIFFLY-STABLE ROSENBROCK METHOD OF ORDER 4,WITH 6 STAGES
+!
+!      E. HAIRER AND G. WANNER,SOLVING ORDINARY DIFFERENTIAL
+!      EQUATIONS II. STIFF AND DIFFERENTIAL-ALGEBRAIC PROBLEMS.
+!      SPRINGER SERIES IN COMPUTATIONAL MATHEMATICS,
+!      SPRINGER-VERLAG (1996)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+    rosmethod = rd4
+!~~~> name of the method
+    ros_Name = 'RODAS-4'
+!~~~> number of stages
+    ros_s = 6
+
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+    ros_alpha(1) = 0.000_dp
+    ros_alpha(2) = 0.386_dp
+    ros_alpha(3) = 0.210_dp
+    ros_alpha(4) = 0.630_dp
+    ros_alpha(5) = 1.000_dp
+    ros_alpha(6) = 1.000_dp
+
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+    ros_gamma(1) = 0.2500000000000000_dp
+    ros_gamma(2) = -0.1043000000000000_dp
+    ros_gamma(3) = 0.1035000000000000_dp
+    ros_gamma(4) = -0.3620000000000023e-01_dp
+    ros_gamma(5) = 0.0_dp
+    ros_gamma(6) = 0.0_dp
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:  A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!                  C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+    ros_a(1) = 0.1544000000000000e+01_dp
+    ros_a(2) = 0.9466785280815826_dp
+    ros_a(3) = 0.2557011698983284_dp
+    ros_a(4) = 0.3314825187068521e+01_dp
+    ros_a(5) = 0.2896124015972201e+01_dp
+    ros_a(6) = 0.9986419139977817_dp
+    ros_a(7) = 0.1221224509226641e+01_dp
+    ros_a(8) = 0.6019134481288629e+01_dp
+    ros_a(9) = 0.1253708332932087e+02_dp
+    ros_a(10) = -0.6878860361058950_dp
+    ros_a(11) = ros_a(7)
+    ros_a(12) = ros_a(8)
+    ros_a(13) = ros_a(9)
+    ros_a(14) = ros_a(10)
+    ros_a(15) = 1.0_dp
+
+    ros_c(1) = -0.5668800000000000e+01_dp
+    ros_c(2) = -0.2430093356833875e+01_dp
+    ros_c(3) = -0.2063599157091915_dp
+    ros_c(4) = -0.1073529058151375_dp
+    ros_c(5) = -0.9594562251023355e+01_dp
+    ros_c(6) = -0.2047028614809616e+02_dp
+    ros_c(7) = 0.7496443313967647e+01_dp
+    ros_c(8) = -0.1024680431464352e+02_dp
+    ros_c(9) = -0.3399990352819905e+02_dp
+    ros_c(10) = 0.1170890893206160e+02_dp
+    ros_c(11) = 0.8083246795921522e+01_dp
+    ros_c(12) = -0.7981132988064893e+01_dp
+    ros_c(13) = -0.3152159432874371e+02_dp
+    ros_c(14) = 0.1631930543123136e+02_dp
+    ros_c(15) = -0.6058818238834054e+01_dp
+
+!~~~> m_i = coefficients for new step solution
+    ros_m(1) = ros_a(7)
+    ros_m(2) = ros_a(8)
+    ros_m(3) = ros_a(9)
+    ros_m(4) = ros_a(10)
+    ros_m(5) = 1.0_dp
+    ros_m(6) = 1.0_dp
+
+!~~~> e_i  = coefficients for error estimator
+    ros_e(1) = 0.0_dp
+    ros_e(2) = 0.0_dp
+    ros_e(3) = 0.0_dp
+    ros_e(4) = 0.0_dp
+    ros_e(5) = 0.0_dp
+    ros_e(6) = 1.0_dp
+
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+    ros_newf(1) = .TRUE.
+    ros_newf(2) = .TRUE.
+    ros_newf(3) = .TRUE.
+    ros_newf(4) = .TRUE.
+    ros_newf(5) = .TRUE.
+    ros_newf(6) = .TRUE.
+
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!        main and the embedded scheme orders plus 1
+    ros_elo = 4.0_dp
+
+  END SUBROUTINE rodas4
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE rang3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! STIFFLY-STABLE W METHOD OF ORDER 3,WITH 4 STAGES
+!
+! J. RANG and L. ANGERMANN
+! NEW ROSENBROCK W-METHODS OF ORDER 3
+! FOR PARTIAL DIFFERENTIAL ALGEBRAIC
+!        EQUATIONS OF INDEX 1                                             
+! BIT Numerical Mathematics (2005) 45: 761-787
+!  DOI: 10.1007/s10543-005-0035-y
+! Table 4.1-4.2
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+    rosmethod = rg3
+!~~~> name of the method
+    ros_Name = 'RANG-3'
+!~~~> number of stages
+    ros_s = 4
+
+    ros_a(1) = 5.09052051067020d+00;
+    ros_a(2) = 5.09052051067020d+00;
+    ros_a(3) = 0.0d0;
+    ros_a(4) = 4.97628111010787d+00;
+    ros_a(5) = 2.77268164715849d-02;
+    ros_a(6) = 2.29428036027904d-01;
+
+    ros_c(1) = - 1.16790812312283d+01;
+    ros_c(2) = - 1.64057326467367d+01;
+    ros_c(3) = - 2.77268164715850d-01;
+    ros_c(4) = - 8.38103960500476d+00;
+    ros_c(5) = - 8.48328409199343d-01;
+    ros_c(6) =  2.87009860433106d-01;
+
+    ros_m(1) =  5.22582761233094d+00;
+    ros_m(2) = - 5.56971148154165d-01;
+    ros_m(3) =  3.57979469353645d-01;
+    ros_m(4) =  1.72337398521064d+00;
+
+    ros_e(1) = - 5.16845212784040d+00;
+    ros_e(2) = - 1.26351942603842d+00;
+    ros_e(3) = - 1.11022302462516d-16;
+    ros_e(4) =  2.22044604925031d-16;
+
+    ros_alpha(1) = 0.0d00;
+    ros_alpha(2) = 2.21878746765329d+00;
+    ros_alpha(3) = 2.21878746765329d+00;
+    ros_alpha(4) = 1.55392337535788d+00;
+
+    ros_gamma(1) =  4.35866521508459d-01;
+    ros_gamma(2) = - 1.78292094614483d+00;
+    ros_gamma(3) = - 2.46541900496934d+00;
+    ros_gamma(4) = - 8.05529997906370d-01;
+
+
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+    ros_newf(1) = .TRUE.
+    ros_newf(2) = .TRUE.
+    ros_newf(3) = .TRUE.
+    ros_newf(4) = .TRUE.
+
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!        main and the embedded scheme orders plus 1
+    ros_elo = 3.0_dp
+
+  END SUBROUTINE rang3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!   End of the set of internal Rosenbrock subroutines
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END SUBROUTINE rosenbrock
+ 
+SUBROUTINE funtemplate( t, y, ydot)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the ODE function call.
+!  Updates the rate coefficients (and possibly the fixed species) at each call
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> input variables
+   REAL(kind=dp):: t, y(nvar)
+!~~~> output variables
+   REAL(kind=dp):: ydot(nvar)
+!~~~> local variables
+   REAL(kind=dp):: told
+
+   told = time
+   time = t
+   CALL fun( y, fix, rconst, ydot)
+   time = told
+
+END SUBROUTINE funtemplate
+ 
+SUBROUTINE jactemplate( t, y, jcb)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the ODE Jacobian call.
+!  Updates the rate coefficients (and possibly the fixed species) at each call
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> input variables
+    REAL(kind=dp):: t, y(nvar)
+!~~~> output variables
+#ifdef full_algebra    
+    REAL(kind=dp):: jv(lu_nonzero), jcb(nvar, nvar)
+#else
+    REAL(kind=dp):: jcb(lu_nonzero)
+#endif   
+!~~~> local variables
+    REAL(kind=dp):: told
+#ifdef full_algebra    
+    INTEGER :: i, j
+#endif   
+
+    told = time
+    time = t
+#ifdef full_algebra    
+    CALL jac_sp(y, fix, rconst, jv)
+    DO j=1, nvar
+      DO i=1, nvar
+         jcb(i, j) = 0.0_dp
+      ENDDO
+    ENDDO
+    DO i=1, lu_nonzero
+       jcb(lu_irow(i), lu_icol(i)) = jv(i)
+    ENDDO
+#else
+    CALL jac_sp( y, fix, rconst, jcb)
+#endif   
+    time = told
+
+END SUBROUTINE jactemplate
+ 
+  SUBROUTINE kppdecomp( jvs, ier)                                    
+  ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
+  !        sparse lu factorization                                    
+  ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
+  ! loop expansion generated by kp4                                   
+                                                                      
+    INTEGER  :: ier                                                   
+    REAL(kind=dp):: jvs(lu_nonzero), w(nvar), a             
+    INTEGER  :: k, kk, j, jj                                          
+                                                                      
+    a = 0.                                                            
+    ier = 0                                                           
+                                                                      
+!   i = 1
+!   i = 2
+    RETURN                                                            
+                                                                      
+  END SUBROUTINE kppdecomp                                            
+ 
+SUBROUTINE chem_gasphase_integrate (time_step_len, conc, tempi, qvapi, fakti, photo, ierrf, xnacc, xnrej, istatus, l_debug, pe, &
+                     icntrl_i, rcntrl_i) 
+                                                                    
+  IMPLICIT NONE                                                     
+                                                                    
+  REAL(dp), INTENT(IN)                  :: time_step_len           
+  REAL(dp), DIMENSION(:, :), INTENT(INOUT) :: conc                    
+  REAL(dp), DIMENSION(:, :), INTENT(IN)   :: photo                   
+  REAL(dp), DIMENSION(:), INTENT(IN)     :: tempi                   
+  REAL(dp), DIMENSION(:), INTENT(IN)     :: qvapi                   
+  REAL(dp), DIMENSION(:), INTENT(IN)     :: fakti                   
+  INTEGER, INTENT(OUT), OPTIONAL        :: ierrf(:)               
+  INTEGER, INTENT(OUT), OPTIONAL        :: xnacc(:)               
+  INTEGER, INTENT(OUT), OPTIONAL        :: xnrej(:)               
+  INTEGER, INTENT(INOUT), OPTIONAL      :: istatus(:)             
+  INTEGER, INTENT(IN), OPTIONAL         :: pe                      
+  LOGICAL, INTENT(IN), OPTIONAL         :: l_debug                 
+  INTEGER, DIMENSION(nkppctrl), INTENT(IN), OPTIONAL  :: icntrl_i         
+  REAL(dp), DIMENSION(nkppctrl), INTENT(IN), OPTIONAL  :: rcntrl_i         
+                                                                    
+  INTEGER                                 :: k   ! loop variable     
+  REAL(dp)                               :: dt                      
+  INTEGER, DIMENSION(20)                :: istatus_u               
+  INTEGER                                :: ierr_u                  
+  INTEGER                                :: istatf                  
+  INTEGER                                :: vl_dim_lo               
+                                                                    
+                                                                    
+  IF (PRESENT (istatus)) istatus = 0                             
+  IF (PRESENT (icntrl_i)) icntrl  = icntrl_i                      
+  IF (PRESENT (rcntrl_i)) rcntrl  = rcntrl_i                      
+                                                                    
+  vl_glo = size(tempi, 1)                                           
+                                                                    
+  vl_dim_lo = vl_dim                                                
+  DO k=1, vl_glo, vl_dim_lo                                           
+    is = k                                                          
+    ie = min(k+ vl_dim_lo-1, vl_glo)                                 
+    vl = ie-is+ 1                                                    
+                                                                    
+    c(:) = conc(is, :)                                            
+                                                                    
+    temp = tempi(is)                                             
+                                                                    
+    qvap = qvapi(is)                                             
+                                                                    
+    fakt = fakti(is)                                             
+                                                                    
+    CALL initialize                                                 
+                                                                    
+    phot(:) = photo(is, :)                                            
+                                                                    
+    CALL update_rconst                                              
+                                                                    
+    dt = time_step_len                                              
+                                                                    
+    ! integrate from t=0 to t=dt                                    
+    CALL integrate(0._dp, dt, icntrl, rcntrl, istatus_u = istatus_u, ierr_u=ierr_u)
+                                                                    
+                                                                    
+   IF (PRESENT(l_debug) .AND. PRESENT(pe)) THEN                       
+      IF (l_debug) CALL error_output(conc(is, :), ierr_u, pe)          
+   ENDIF                                                              
+                                                                      
+    conc(is, :) = c(:)                                                
+                                                                    
+    ! RETURN diagnostic information                                 
+                                                                    
+    IF (PRESENT(ierrf))   ierrf(is) = ierr_u                      
+    IF (PRESENT(xnacc))   xnacc(is) = istatus_u(4)               
+    IF (PRESENT(xnrej))   xnrej(is) = istatus_u(5)               
+                                                                    
+    IF (PRESENT (istatus)) THEN                                   
+      istatus(1:8) = istatus(1:8) + istatus_u(1:8)                
+    ENDIF                                                          
+                                                                    
+  END DO                                                            
+ 
+                                                                    
+! Deallocate input arrays                                           
+                                                                    
+                                                                    
+  data_loaded = .FALSE.                                             
+                                                                    
+  RETURN                                                            
+END SUBROUTINE chem_gasphase_integrate                                        
+
+END MODULE chem_gasphase_mod
+ 
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_passive/chem_gasphase_mod.kpp
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_passive/chem_gasphase_mod.kpp	(revision 3297)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_passive/chem_gasphase_mod.kpp	(revision 3298)
@@ -11,7 +11,4 @@
 #HESSIAN    on
 #STOICMAT   on
-#INLINE F90_GLOBAL
-  !   Declaration of global variable declarations for photolysis will come from INLINE F90_DATA
-#ENDINLINE
 //
 // *******************************************************************************************
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_passive1/chem_gasphase_mod.f90
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_passive1/chem_gasphase_mod.f90	(revision 3298)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_passive1/chem_gasphase_mod.f90	(revision 3298)
@@ -0,0 +1,2318 @@
+MODULE chem_gasphase_mod
+ 
+!   Mechanism: passive1
+!
+!------------------------------------------------------------------------------!
+!
+! ******Module chem_gasphase_mod is automatically generated by kpp4palm ******
+!
+!   *********Please do NOT change this Code,it will be ovewritten *********
+!
+!------------------------------------------------------------------------------!
+! This file was created by KPP (http://people.cs.vt.edu/asandu/Software/Kpp/)
+! and kpp4palm (created by Klaus Ketelsen). kpp4palm is an adapted version 
+! of KP4 (JÃ¶ckel,P.,Kerkweg,A.,Pozzer,A.,Sander,R.,Tost,H.,Riede,
+! H.,Baumgaertner,A.,Gromov,S.,and Kern,B.,2010: Development cycle 2 of
+! the Modular Earth Submodel System (MESSy2),Geosci. Model Dev.,3,717-752,
+! https://doi.org/10.5194/gmd-3-717-2010). KP4 is part of the Modular Earth 
+! Submodel System (MESSy),which is is available under the  GNU General Public 
+! License (GPL).
+!
+! KPP is free software; you can redistribute it and/or modify it under the terms 
+! of the General Public Licence as published by the Free Software Foundation; 
+! either version 2 of the License,or (at your option) any later version. 
+! KPP is distributed in the hope that it will be useful,but WITHOUT ANY WARRANTY; 
+! without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 
+! PURPOSE. See the GNU General Public Licence for more details. 
+!
+!------------------------------------------------------------------------------!
+! This file is part of the PALM model system.
+!
+! PALM is free software: you can redistribute it and/or modify it under the
+! terms of the GNU General Public License as published by the Free Software
+! Foundation,either version 3 of the License,or (at your option) any later
+! version.
+!
+! PALM is distributed in the hope that it will be useful,but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not,see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2018 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! ------------------
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id: module_header 2460 2017-09-13 14:47:48Z forkel $
+! forkel June 2018: qvap,fakt added
+! forkel June 2018: reset case in  Initialize,Integrate,Update_rconst
+! 
+! 
+! 2460 2017-09-13 14:47:48Z forkel
+!
+! forkel Sept. 2017: Variables for photolyis added
+!
+!
+! Nov. 2016: Intial version (Klaus Ketelsen)
+!
+!------------------------------------------------------------------------------!
+!
+
+
+! Set kpp Double Precision to PALM Default Precision
+
+  USE kinds,           ONLY: dp=>wp
+
+  USE pegrid,          ONLY: myid, threads_per_task
+
+  IMPLICIT        NONE
+  PRIVATE
+  !SAVE  ! note: occurs again in automatically generated code ...
+
+!  PUBLIC :: IERR_NAMES
+ 
+! PUBLIC :: SPC_NAMES,EQN_NAMES,EQN_TAGS,REQ_HET,REQ_AEROSOL,REQ_PHOTRAT &
+!         ,REQ_MCFCT,IP_MAX,jname
+
+  PUBLIC :: eqn_names, phot_names, spc_names
+  PUBLIC :: nmaxfixsteps
+  PUBLIC :: atol, rtol
+  PUBLIC :: nspec, nreact
+  PUBLIC :: temp
+  PUBLIC :: qvap
+  PUBLIC :: fakt
+  PUBLIC :: phot 
+  PUBLIC :: rconst
+  PUBLIC :: nvar
+  PUBLIC :: nphot
+  PUBLIC :: vl_dim                     ! PUBLIC to ebable other MODULEs to distiguish between scalar and vec
+ 
+  PUBLIC :: initialize, integrate, update_rconst
+  PUBLIC :: chem_gasphase_integrate
+  PUBLIC :: initialize_kpp_ctrl
+
+! END OF MODULE HEADER TEMPLATE
+                                                                 
+! Variables used for vector mode                                 
+                                                                 
+  LOGICAL, PARAMETER          :: l_vector = .FALSE.            
+  INTEGER, PARAMETER          :: i_lu_di = 2
+  INTEGER, PARAMETER          :: vl_dim = 1
+  INTEGER                     :: vl                              
+                                                                 
+  INTEGER                     :: vl_glo                          
+  INTEGER                     :: is, ie                           
+                                                                 
+                                                                 
+  INTEGER, DIMENSION(vl_dim)  :: kacc, krej                       
+  INTEGER, DIMENSION(vl_dim)  :: ierrv                           
+  LOGICAL                     :: data_loaded = .FALSE.             
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Parameter Module File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Parameters.f90
+! Time                 : Tue Sep 25 18:34:54 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! NSPEC - Number of chemical species
+  INTEGER, PARAMETER :: nspec = 1 
+! NVAR - Number of Variable species
+  INTEGER, PARAMETER :: nvar = 1 
+! NVARACT - Number of Active species
+  INTEGER, PARAMETER :: nvaract = 1 
+! NFIX - Number of Fixed species
+  INTEGER, PARAMETER :: nfix = 1 
+! NREACT - Number of reactions
+  INTEGER, PARAMETER :: nreact = 1 
+! NVARST - Starting of variables in conc. vect.
+  INTEGER, PARAMETER :: nvarst = 1 
+! NFIXST - Starting of fixed in conc. vect.
+  INTEGER, PARAMETER :: nfixst = 2 
+! NONZERO - Number of nonzero entries in Jacobian
+  INTEGER, PARAMETER :: nonzero = 1 
+! LU_NONZERO - Number of nonzero entries in LU factoriz. of Jacobian
+  INTEGER, PARAMETER :: lu_nonzero = 1 
+! CNVAR - (NVAR+1) Number of elements in compressed row format
+  INTEGER, PARAMETER :: cnvar = 2 
+! CNEQN - (NREACT+1) Number stoicm elements in compressed col format
+  INTEGER, PARAMETER :: cneqn = 2 
+! NHESS - Length of Sparse Hessian
+  INTEGER, PARAMETER :: nhess = 1 
+! NMASS - Number of atoms to check mass balance
+  INTEGER, PARAMETER :: nmass = 1 
+
+! Index declaration for variable species in C and VAR
+!   VAR(ind_spc) = C(ind_spc)
+
+  INTEGER, PARAMETER, PUBLIC :: ind_pm10 = 1 
+
+! Index declaration for fixed species in C
+!   C(ind_spc)
+
+
+! Index declaration for fixed species in FIX
+!    FIX(indf_spc) = C(ind_spc) = C(NVAR+indf_spc)
+
+
+! NJVRP - Length of sparse Jacobian JVRP
+  INTEGER, PARAMETER :: njvrp = 1 
+
+! NSTOICM - Length of Sparse Stoichiometric Matrix
+  INTEGER, PARAMETER :: nstoicm = 1 
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Global Data Module File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Global.f90
+! Time                 : Tue Sep 25 18:34:54 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! Declaration of global variables
+
+! C - Concentration of all species
+  REAL(kind=dp):: c(nspec)
+! VAR - Concentrations of variable species (global)
+  REAL(kind=dp):: var(nvar)
+! FIX - Concentrations of fixed species (global)
+  REAL(kind=dp):: fix(nfix)
+! VAR,FIX are chunks of array C
+      EQUIVALENCE( c(1), var(1))
+! RCONST - Rate constants (global)
+  REAL(kind=dp):: rconst(nreact)
+! TIME - Current integration time
+  REAL(kind=dp):: time
+! TEMP - Temperature
+  REAL(kind=dp):: temp
+! TSTART - Integration start time
+  REAL(kind=dp):: tstart
+! ATOL - Absolute tolerance
+  REAL(kind=dp):: atol(nvar)
+! RTOL - Relative tolerance
+  REAL(kind=dp):: rtol(nvar)
+! STEPMIN - Lower bound for integration step
+  REAL(kind=dp):: stepmin
+! CFACTOR - Conversion factor for concentration units
+  REAL(kind=dp):: cfactor
+
+! INLINED global variable declarations
+
+! QVAP - Water vapor
+  REAL(kind=dp):: qvap
+! FAKT - Conversion factor
+  REAL(kind=dp):: fakt
+
+
+! INLINED global variable declarations
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Sparse Jacobian Data Structures File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_JacobianSP.f90
+! Time                 : Tue Sep 25 18:34:54 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! Sparse Jacobian Data
+
+
+  INTEGER, PARAMETER, DIMENSION(1):: lu_irow =  (/ &
+       1 /) 
+
+  INTEGER, PARAMETER, DIMENSION(1):: lu_icol =  (/ &
+       1 /) 
+
+  INTEGER, PARAMETER, DIMENSION(2):: lu_crow =  (/ &
+       1, 2 /) 
+
+  INTEGER, PARAMETER, DIMENSION(2):: lu_diag =  (/ &
+       1, 2 /) 
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Utility Data Module File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Monitor.f90
+! Time                 : Tue Sep 25 18:34:54 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+  CHARACTER(len=15), PARAMETER, DIMENSION(1):: spc_names =  (/ &
+     'PM10           ' /)
+
+  CHARACTER(len=100), PARAMETER, DIMENSION(1):: eqn_names =  (/ &
+     'PM10 --> PM10                                                                                       ' /)
+
+! INLINED global variables
+
+  !   inline f90_data: declaration of global variables for photolysis
+  !   REAL(kind=dp):: phot(nphot)must eventually be moved to global later for 
+  INTEGER, PARAMETER :: nphot = 1
+  !   phot photolysis frequencies
+  REAL(kind=dp):: phot(nphot)
+
+  INTEGER, PARAMETER, PUBLIC :: j_no2 = 1
+
+  CHARACTER(len=15), PARAMETER, DIMENSION(nphot):: phot_names =   (/ &
+     'J_NO2          '/)
+
+! End INLINED global variables
+
+
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+ 
+!  variable definations from  individual module headers 
+ 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Initialization File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Initialize.f90
+! Time                 : Tue Sep 25 18:34:54 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Numerical Integrator (Time-Stepping) File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Integrator.f90
+! Time                 : Tue Sep 25 18:34:54 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! INTEGRATE - Integrator routine
+!   Arguments :
+!      TIN       - Start Time for Integration
+!      TOUT      - End Time for Integration
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
+!  Rosenbrock - Implementation of several Rosenbrock methods:             !
+!               *Ros2                                                    !
+!               *Ros3                                                    !
+!               *Ros4                                                    !
+!               *Rodas3                                                  !
+!               *Rodas4                                                  !
+!  By default the code employs the KPP sparse linear algebra routines     !
+!  Compile with -DFULL_ALGEBRA to use full linear algebra (LAPACK)        !
+!                                                                         !
+!    (C)  Adrian Sandu,August 2004                                       !
+!    Virginia Polytechnic Institute and State University                  !
+!    Contact: sandu@cs.vt.edu                                             !
+!    Revised by Philipp Miehe and Adrian Sandu,May 2006                  !                               !
+!    This implementation is part of KPP - the Kinetic PreProcessor        !
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
+
+
+  SAVE
+  
+!~~~>  statistics on the work performed by the rosenbrock method
+  INTEGER, PARAMETER :: nfun=1, njac=2, nstp=3, nacc=4, &
+                        nrej=5, ndec=6, nsol=7, nsng=8, &
+                        ntexit=1, nhexit=2, nhnew = 3
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Linear Algebra Data and Routines File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_LinearAlgebra.f90
+! Time                 : Tue Sep 25 18:34:54 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! The ODE Jacobian of Chemical Model File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Jacobian.f90
+! Time                 : Tue Sep 25 18:34:54 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! The ODE Function of Chemical Model File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Function.f90
+! Time                 : Tue Sep 25 18:34:54 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+! A - Rate for each equation
+  REAL(kind=dp):: a(nreact)
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! The Reaction Rates File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Rates.f90
+! Time                 : Tue Sep 25 18:34:54 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Auxiliary Routines File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Util.f90
+! Time                 : Tue Sep 25 18:34:54 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+  ! header MODULE initialize_kpp_ctrl_template
+
+  ! notes:
+  ! - l_vector is automatically defined by kp4
+  ! - vl_dim is automatically defined by kp4
+  ! - i_lu_di is automatically defined by kp4
+  ! - wanted is automatically defined by xmecca
+  ! - icntrl rcntrl are automatically defined by kpp
+  ! - "USE messy_main_tools" is in MODULE_header of messy_mecca_kpp.f90
+  ! - SAVE will be automatically added by kp4
+
+  !SAVE
+
+  ! for fixed time step control
+  ! ... max. number of fixed time steps (sum must be 1)
+  INTEGER, PARAMETER         :: nmaxfixsteps = 50
+  ! ... switch for fixed time stepping
+  LOGICAL, PUBLIC            :: l_fixed_step = .FALSE.
+  INTEGER, PUBLIC            :: nfsteps = 1
+  ! ... number of kpp control PARAMETERs
+  INTEGER, PARAMETER, PUBLIC :: nkppctrl = 20
+  !
+  INTEGER, DIMENSION(nkppctrl), PUBLIC     :: icntrl = 0
+  REAL(dp), DIMENSION(nkppctrl), PUBLIC     :: rcntrl = 0.0_dp
+  REAL(dp), DIMENSION(nmaxfixsteps), PUBLIC :: t_steps = 0.0_dp
+
+  ! END header MODULE initialize_kpp_ctrl_template
+
+ 
+! Interface Block 
+ 
+  INTERFACE            initialize
+    MODULE PROCEDURE   initialize
+  END INTERFACE        initialize
+ 
+  INTERFACE            integrate
+    MODULE PROCEDURE   integrate
+  END INTERFACE        integrate
+ 
+  INTERFACE            fun
+    MODULE PROCEDURE   fun
+  END INTERFACE        fun
+ 
+  INTERFACE            kppsolve
+    MODULE PROCEDURE   kppsolve
+  END INTERFACE        kppsolve
+ 
+  INTERFACE            jac_sp
+    MODULE PROCEDURE   jac_sp
+  END INTERFACE        jac_sp
+ 
+  INTERFACE            k_arr
+    MODULE PROCEDURE   k_arr
+  END INTERFACE        k_arr
+ 
+  INTERFACE            update_rconst
+    MODULE PROCEDURE   update_rconst
+  END INTERFACE        update_rconst
+ 
+  INTERFACE            arr2
+    MODULE PROCEDURE   arr2
+  END INTERFACE        arr2
+ 
+  INTERFACE            initialize_kpp_ctrl
+    MODULE PROCEDURE   initialize_kpp_ctrl
+  END INTERFACE        initialize_kpp_ctrl
+ 
+  INTERFACE            error_output
+    MODULE PROCEDURE   error_output
+  END INTERFACE        error_output
+ 
+  INTERFACE            wscal
+    MODULE PROCEDURE   wscal
+  END INTERFACE        wscal
+ 
+!INTERFACE not working  INTERFACE            waxpy
+!INTERFACE not working    MODULE PROCEDURE   waxpy
+!INTERFACE not working  END INTERFACE        waxpy
+ 
+  INTERFACE            rosenbrock
+    MODULE PROCEDURE   rosenbrock
+  END INTERFACE        rosenbrock
+ 
+  INTERFACE            funtemplate
+    MODULE PROCEDURE   funtemplate
+  END INTERFACE        funtemplate
+ 
+  INTERFACE            jactemplate
+    MODULE PROCEDURE   jactemplate
+  END INTERFACE        jactemplate
+ 
+  INTERFACE            kppdecomp
+    MODULE PROCEDURE   kppdecomp
+  END INTERFACE        kppdecomp
+ 
+  INTERFACE            chem_gasphase_integrate
+    MODULE PROCEDURE   chem_gasphase_integrate
+  END INTERFACE        chem_gasphase_integrate
+ 
+ 
+ CONTAINS
+ 
+SUBROUTINE initialize()
+
+
+  INTEGER         :: j, k
+
+  INTEGER :: i
+  REAL(kind=dp):: x
+  k = is
+  cfactor = 1.000000e+00_dp
+
+  x = (0.) * cfactor
+  DO i = 1 , nvar
+  ENDDO
+
+  x = (0.) * cfactor
+  DO i = 1 , nfix
+    fix(i) = x
+  ENDDO
+
+! constant rate coefficients
+! END constant rate coefficients
+
+! INLINED initializations
+
+! End INLINED initializations
+
+      
+END SUBROUTINE initialize
+ 
+SUBROUTINE integrate( tin, tout, &
+  icntrl_u, rcntrl_u, istatus_u, rstatus_u, ierr_u)
+
+
+   REAL(kind=dp), INTENT(IN):: tin  ! start time
+   REAL(kind=dp), INTENT(IN):: tout ! END time
+   ! OPTIONAL input PARAMETERs and statistics
+   INTEGER,      INTENT(IN), OPTIONAL :: icntrl_u(20)
+   REAL(kind=dp), INTENT(IN), OPTIONAL :: rcntrl_u(20)
+   INTEGER,      INTENT(OUT), OPTIONAL :: istatus_u(20)
+   REAL(kind=dp), INTENT(OUT), OPTIONAL :: rstatus_u(20)
+   INTEGER,      INTENT(OUT), OPTIONAL :: ierr_u
+
+   REAL(kind=dp):: rcntrl(20), rstatus(20)
+   INTEGER       :: icntrl(20), istatus(20), ierr
+
+   INTEGER, SAVE :: ntotal = 0
+
+   icntrl(:) = 0
+   rcntrl(:) = 0.0_dp
+   istatus(:) = 0
+   rstatus(:) = 0.0_dp
+
+    !~~~> fine-tune the integrator:
+   icntrl(1) = 0      ! 0 - non- autonomous, 1 - autonomous
+   icntrl(2) = 0      ! 0 - vector tolerances, 1 - scalars
+
+   ! IF OPTIONAL PARAMETERs are given, and IF they are >0, 
+   ! THEN they overwrite default settings. 
+   IF (PRESENT(icntrl_u))THEN
+     WHERE(icntrl_u(:)> 0)icntrl(:) = icntrl_u(:)
+   ENDIF
+   IF (PRESENT(rcntrl_u))THEN
+     WHERE(rcntrl_u(:)> 0)rcntrl(:) = rcntrl_u(:)
+   ENDIF
+
+
+   CALL rosenbrock(nvar, var, tin, tout,  &
+         atol, rtol,               &
+         rcntrl, icntrl, rstatus, istatus, ierr)
+
+   !~~~> debug option: show no of steps
+   ! ntotal = ntotal + istatus(nstp)
+   ! PRINT*,'NSTEPS=',ISTATUS(Nstp),' (',Ntotal,')','  O3=',VAR(ind_O3)
+
+   stepmin = rstatus(nhexit)
+   ! IF OPTIONAL PARAMETERs are given for output they 
+   ! are updated with the RETURN information
+   IF (PRESENT(istatus_u))istatus_u(:) = istatus(:)
+   IF (PRESENT(rstatus_u))rstatus_u(:) = rstatus(:)
+   IF (PRESENT(ierr_u))  ierr_u       = ierr
+
+END SUBROUTINE integrate
+ 
+SUBROUTINE fun(v, f, rct, vdot)
+
+! V - Concentrations of variable species (local)
+  REAL(kind=dp):: v(nvar)
+! F - Concentrations of fixed species (local)
+  REAL(kind=dp):: f(nfix)
+! RCT - Rate constants (local)
+  REAL(kind=dp):: rct(nreact)
+! Vdot - Time derivative of variable species concentrations
+  REAL(kind=dp):: vdot(nvar)
+
+
+! Computation of equation rates
+
+! Aggregate function
+  vdot(1) = 0
+      
+END SUBROUTINE fun
+ 
+SUBROUTINE kppsolve(jvs, x)
+
+! JVS - sparse Jacobian of variables
+  REAL(kind=dp):: jvs(lu_nonzero)
+! X - Vector for variables
+  REAL(kind=dp):: x(nvar)
+
+  x(1) = x(1) / jvs(1)
+      
+END SUBROUTINE kppsolve
+ 
+SUBROUTINE jac_sp(v, f, rct, jvs)
+
+! V - Concentrations of variable species (local)
+  REAL(kind=dp):: v(nvar)
+! F - Concentrations of fixed species (local)
+  REAL(kind=dp):: f(nfix)
+! RCT - Rate constants (local)
+  REAL(kind=dp):: rct(nreact)
+! JVS - sparse Jacobian of variables
+  REAL(kind=dp):: jvs(lu_nonzero)
+
+
+! Local variables
+! B - Temporary array
+  REAL(kind=dp):: b(1)
+
+! B(1) = dA(1)/dV(1)
+  b(1) = rct(1)
+
+! Construct the Jacobian terms from B's
+! JVS(1) = Jac_FULL(1,1)
+  jvs(1) = 0
+      
+END SUBROUTINE jac_sp
+ 
+  elemental REAL(kind=dp)FUNCTION k_arr (k_298, tdep, temp)
+    ! arrhenius FUNCTION
+
+    REAL,    INTENT(IN):: k_298 ! k at t = 298.15k
+    REAL,    INTENT(IN):: tdep  ! temperature dependence
+    REAL(kind=dp), INTENT(IN):: temp  ! temperature
+
+    intrinsic exp
+
+    k_arr = k_298 * exp(tdep* (1._dp/temp- 3.3540e-3_dp))! 1/298.15=3.3540e-3
+
+  END FUNCTION k_arr
+ 
+SUBROUTINE update_rconst()
+ INTEGER         :: k
+
+  k = is
+
+! Begin INLINED RCONST
+
+
+! End INLINED RCONST
+
+  rconst(1) = (1.0_dp)
+      
+END SUBROUTINE update_rconst
+ 
+!  END FUNCTION ARR2
+REAL(kind=dp)FUNCTION arr2( a0, b0, temp)
+    REAL(kind=dp):: temp
+    REAL(kind=dp):: a0, b0
+    arr2 = a0 * exp( - b0 / temp)
+END FUNCTION arr2
+ 
+SUBROUTINE initialize_kpp_ctrl(status)
+
+
+  ! i/o
+  INTEGER,         INTENT(OUT):: status
+
+  ! local
+  REAL(dp):: tsum
+  INTEGER  :: i
+
+  ! check fixed time steps
+  tsum = 0.0_dp
+  DO i=1, nmaxfixsteps
+     IF (t_steps(i)< tiny(0.0_dp))exit
+     tsum = tsum + t_steps(i)
+  ENDDO
+
+  nfsteps = i- 1
+
+  l_fixed_step = (nfsteps > 0).and.((tsum - 1.0)< tiny(0.0_dp))
+
+  IF (l_vector)THEN
+     WRITE(*,*) ' MODE             : VECTOR (LENGTH=',VL_DIM,')'
+  ELSE
+     WRITE(*,*) ' MODE             : SCALAR'
+  ENDIF
+  !
+  WRITE(*,*) ' DE-INDEXING MODE :',I_LU_DI
+  !
+  WRITE(*,*) ' ICNTRL           : ',icntrl
+  WRITE(*,*) ' RCNTRL           : ',rcntrl
+  !
+  ! note: this is ONLY meaningful for vectorized (kp4)rosenbrock- methods
+  IF (l_vector)THEN
+     IF (l_fixed_step)THEN
+        WRITE(*,*) ' TIME STEPS       : FIXED (',t_steps(1:nfsteps),')'
+     ELSE
+        WRITE(*,*) ' TIME STEPS       : AUTOMATIC'
+     ENDIF
+  ELSE
+     WRITE(*,*) ' TIME STEPS       : AUTOMATIC '//&
+          &'(t_steps (CTRL_KPP) ignored in SCALAR MODE)'
+  ENDIF
+  ! mz_pj_20070531- 
+
+  status = 0
+
+
+END SUBROUTINE initialize_kpp_ctrl
+ 
+SUBROUTINE error_output(c, ierr, pe)
+
+
+  INTEGER, INTENT(IN):: ierr
+  INTEGER, INTENT(IN):: pe
+  REAL(dp), DIMENSION(:), INTENT(IN):: c
+
+  write(6,*) 'ERROR in chem_gasphase_mod ',ierr,C(1)
+
+
+END SUBROUTINE error_output
+ 
+      SUBROUTINE wscal(n, alpha, x, incx)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+!     constant times a vector: x(1:N) <- Alpha*x(1:N) 
+!     only for incX=incY=1
+!     after BLAS
+!     replace this by the function from the optimized BLAS implementation:
+!         CALL SSCAL(N,Alpha,X,1) or  CALL DSCAL(N,Alpha,X,1)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+
+      INTEGER  :: i, incx, m, mp1, n
+      REAL(kind=dp) :: x(n), alpha
+      REAL(kind=dp), PARAMETER  :: zero=0.0_dp, one=1.0_dp
+
+      IF (alpha .eq. one)RETURN
+      IF (n .le. 0)RETURN
+
+      m = mod(n, 5)
+      IF ( m .ne. 0)THEN
+        IF (alpha .eq. (- one))THEN
+          DO i = 1, m
+            x(i) = - x(i)
+          ENDDO
+        ELSEIF (alpha .eq. zero)THEN
+          DO i = 1, m
+            x(i) = zero
+          ENDDO
+        ELSE
+          DO i = 1, m
+            x(i) = alpha* x(i)
+          ENDDO
+        ENDIF
+        IF ( n .lt. 5)RETURN
+      ENDIF
+      mp1 = m + 1
+      IF (alpha .eq. (- one))THEN
+        DO i = mp1, n, 5
+          x(i)   = - x(i)
+          x(i + 1) = - x(i + 1)
+          x(i + 2) = - x(i + 2)
+          x(i + 3) = - x(i + 3)
+          x(i + 4) = - x(i + 4)
+        ENDDO
+      ELSEIF (alpha .eq. zero)THEN
+        DO i = mp1, n, 5
+          x(i)   = zero
+          x(i + 1) = zero
+          x(i + 2) = zero
+          x(i + 3) = zero
+          x(i + 4) = zero
+        ENDDO
+      ELSE
+        DO i = mp1, n, 5
+          x(i)   = alpha* x(i)
+          x(i + 1) = alpha* x(i + 1)
+          x(i + 2) = alpha* x(i + 2)
+          x(i + 3) = alpha* x(i + 3)
+          x(i + 4) = alpha* x(i + 4)
+        ENDDO
+      ENDIF
+
+      END SUBROUTINE wscal
+ 
+      SUBROUTINE waxpy(n, alpha, x, incx, y, incy)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+!     constant times a vector plus a vector: y <- y + Alpha*x
+!     only for incX=incY=1
+!     after BLAS
+!     replace this by the function from the optimized BLAS implementation:
+!         CALL SAXPY(N,Alpha,X,1,Y,1) or  CALL DAXPY(N,Alpha,X,1,Y,1)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+
+      INTEGER  :: i, incx, incy, m, mp1, n
+      REAL(kind=dp):: x(n), y(n), alpha
+      REAL(kind=dp), PARAMETER :: zero = 0.0_dp
+
+      IF (alpha .eq. zero)RETURN
+      IF (n .le. 0)RETURN
+
+      m = mod(n, 4)
+      IF ( m .ne. 0)THEN
+        DO i = 1, m
+          y(i) = y(i) + alpha* x(i)
+        ENDDO
+        IF ( n .lt. 4)RETURN
+      ENDIF
+      mp1 = m + 1
+      DO i = mp1, n, 4
+        y(i) = y(i) + alpha* x(i)
+        y(i + 1) = y(i + 1) + alpha* x(i + 1)
+        y(i + 2) = y(i + 2) + alpha* x(i + 2)
+        y(i + 3) = y(i + 3) + alpha* x(i + 3)
+      ENDDO
+      
+      END SUBROUTINE waxpy
+ 
+SUBROUTINE rosenbrock(n, y, tstart, tend, &
+           abstol, reltol,             &
+           rcntrl, icntrl, rstatus, istatus, ierr)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!    Solves the system y'=F(t,y) using a Rosenbrock method defined by:
+!
+!     G = 1/(H*gamma(1)) - Jac(t0,Y0)
+!     T_i = t0 + Alpha(i)*H
+!     Y_i = Y0 + \sum_{j=1}^{i-1} A(i,j)*K_j
+!     G *K_i = Fun( T_i,Y_i)+ \sum_{j=1}^S C(i,j)/H *K_j +
+!         gamma(i)*dF/dT(t0,Y0)
+!     Y1 = Y0 + \sum_{j=1}^S M(j)*K_j
+!
+!    For details on Rosenbrock methods and their implementation consult:
+!      E. Hairer and G. Wanner
+!      "Solving ODEs II. Stiff and differential-algebraic problems".
+!      Springer series in computational mathematics,Springer-Verlag,1996.
+!    The codes contained in the book inspired this implementation.
+!
+!    (C)  Adrian Sandu,August 2004
+!    Virginia Polytechnic Institute and State University
+!    Contact: sandu@cs.vt.edu
+!    Revised by Philipp Miehe and Adrian Sandu,May 2006                  
+!    This implementation is part of KPP - the Kinetic PreProcessor
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!~~~>   input arguments:
+!
+!-     y(n)  = vector of initial conditions (at t=tstart)
+!-    [tstart, tend]  = time range of integration
+!     (if Tstart>Tend the integration is performed backwards in time)
+!-    reltol, abstol = user precribed accuracy
+!- SUBROUTINE  fun( t, y, ydot) = ode FUNCTION, 
+!                       returns Ydot = Y' = F(T,Y)
+!- SUBROUTINE  jac( t, y, jcb) = jacobian of the ode FUNCTION, 
+!                       returns Jcb = dFun/dY
+!-    icntrl(1:20)  = INTEGER inputs PARAMETERs
+!-    rcntrl(1:20)  = REAL inputs PARAMETERs
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!~~~>     output arguments:
+!
+!-    y(n)  - > vector of final states (at t- >tend)
+!-    istatus(1:20) - > INTEGER output PARAMETERs
+!-    rstatus(1:20) - > REAL output PARAMETERs
+!-    ierr            - > job status upon RETURN
+!                        success (positive value) or
+!                        failure (negative value)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!~~~>     input PARAMETERs:
+!
+!    Note: For input parameters equal to zero the default values of the
+!       corresponding variables are used.
+!
+!    ICNTRL(1) = 1: F = F(y)   Independent of T (AUTONOMOUS)
+!              = 0: F = F(t,y) Depends on T (NON-AUTONOMOUS)
+!
+!    ICNTRL(2) = 0: AbsTol,RelTol are N-dimensional vectors
+!              = 1: AbsTol,RelTol are scalars
+!
+!    ICNTRL(3)  -> selection of a particular Rosenbrock method
+!        = 0 :    Rodas3 (default)
+!        = 1 :    Ros2
+!        = 2 :    Ros3
+!        = 3 :    Ros4
+!        = 4 :    Rodas3
+!        = 5 :    Rodas4
+!
+!    ICNTRL(4)  -> maximum number of integration steps
+!        For ICNTRL(4) =0) the default value of 100000 is used
+!
+!    RCNTRL(1)  -> Hmin,lower bound for the integration step size
+!          It is strongly recommended to keep Hmin = ZERO
+!    RCNTRL(2)  -> Hmax,upper bound for the integration step size
+!    RCNTRL(3)  -> Hstart,starting value for the integration step size
+!
+!    RCNTRL(4)  -> FacMin,lower bound on step decrease factor (default=0.2)
+!    RCNTRL(5)  -> FacMax,upper bound on step increase factor (default=6)
+!    RCNTRL(6)  -> FacRej,step decrease factor after multiple rejections
+!                          (default=0.1)
+!    RCNTRL(7)  -> FacSafe,by which the new step is slightly smaller
+!         than the predicted value  (default=0.9)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!
+!    OUTPUT ARGUMENTS:
+!    -----------------
+!
+!    T           -> T value for which the solution has been computed
+!                     (after successful return T=Tend).
+!
+!    Y(N)        -> Numerical solution at T
+!
+!    IDID        -> Reports on successfulness upon return:
+!                    = 1 for success
+!                    < 0 for error (value equals error code)
+!
+!    ISTATUS(1)  -> No. of function calls
+!    ISTATUS(2)  -> No. of jacobian calls
+!    ISTATUS(3)  -> No. of steps
+!    ISTATUS(4)  -> No. of accepted steps
+!    ISTATUS(5)  -> No. of rejected steps (except at very beginning)
+!    ISTATUS(6)  -> No. of LU decompositions
+!    ISTATUS(7)  -> No. of forward/backward substitutions
+!    ISTATUS(8)  -> No. of singular matrix decompositions
+!
+!    RSTATUS(1)  -> Texit,the time corresponding to the
+!                     computed Y upon return
+!    RSTATUS(2)  -> Hexit,last accepted step before exit
+!    RSTATUS(3)  -> Hnew,last predicted step (not yet taken)
+!                   For multiple restarts,use Hnew as Hstart 
+!                     in the subsequent run
+!
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~>  arguments
+   INTEGER,      INTENT(IN)  :: n
+   REAL(kind=dp), INTENT(INOUT):: y(n)
+   REAL(kind=dp), INTENT(IN)  :: tstart, tend
+   REAL(kind=dp), INTENT(IN)  :: abstol(n), reltol(n)
+   INTEGER,      INTENT(IN)  :: icntrl(20)
+   REAL(kind=dp), INTENT(IN)  :: rcntrl(20)
+   INTEGER,      INTENT(INOUT):: istatus(20)
+   REAL(kind=dp), INTENT(INOUT):: rstatus(20)
+   INTEGER, INTENT(OUT) :: ierr
+!~~~>  PARAMETERs of the rosenbrock method, up to 6 stages
+   INTEGER ::  ros_s, rosmethod
+   INTEGER, PARAMETER :: rs2=1, rs3=2, rs4=3, rd3=4, rd4=5, rg3=6
+   REAL(kind=dp):: ros_a(15), ros_c(15), ros_m(6), ros_e(6), &
+                    ros_alpha(6), ros_gamma(6), ros_elo
+   LOGICAL :: ros_newf(6)
+   CHARACTER(len=12):: ros_name
+!~~~>  local variables
+   REAL(kind=dp):: roundoff, facmin, facmax, facrej, facsafe
+   REAL(kind=dp):: hmin, hmax, hstart
+   REAL(kind=dp):: texit
+   INTEGER       :: i, uplimtol, max_no_steps
+   LOGICAL       :: autonomous, vectortol
+!~~~>   PARAMETERs
+   REAL(kind=dp), PARAMETER :: zero = 0.0_dp, one  = 1.0_dp
+   REAL(kind=dp), PARAMETER :: deltamin = 1.0e-5_dp
+
+!~~~>  initialize statistics
+   istatus(1:8) = 0
+   rstatus(1:3) = zero
+
+!~~~>  autonomous or time dependent ode. default is time dependent.
+   autonomous = .not.(icntrl(1) == 0)
+
+!~~~>  for scalar tolerances (icntrl(2).ne.0) the code uses abstol(1)and reltol(1)
+!   For Vector tolerances (ICNTRL(2) == 0) the code uses AbsTol(1:N) and RelTol(1:N)
+   IF (icntrl(2) == 0)THEN
+      vectortol = .TRUE.
+      uplimtol  = n
+   ELSE
+      vectortol = .FALSE.
+      uplimtol  = 1
+   ENDIF
+
+!~~~>   initialize the particular rosenbrock method selected
+   select CASE (icntrl(3))
+     CASE (1)
+       CALL ros2
+     CASE (2)
+       CALL ros3
+     CASE (3)
+       CALL ros4
+     CASE (0, 4)
+       CALL rodas3
+     CASE (5)
+       CALL rodas4
+     CASE (6)
+       CALL rang3
+     CASE default
+       PRINT *,'Unknown Rosenbrock method: ICNTRL(3) =',ICNTRL(3) 
+       CALL ros_errormsg(- 2, tstart, zero, ierr)
+       RETURN
+   END select
+
+!~~~>   the maximum number of steps admitted
+   IF (icntrl(4) == 0)THEN
+      max_no_steps = 200000
+   ELSEIF (icntrl(4)> 0)THEN
+      max_no_steps=icntrl(4)
+   ELSE
+      PRINT *,'User-selected max no. of steps: ICNTRL(4) =',ICNTRL(4)
+      CALL ros_errormsg(- 1, tstart, zero, ierr)
+      RETURN
+   ENDIF
+
+!~~~>  unit roundoff (1+ roundoff>1)
+   roundoff = epsilon(one)
+
+!~~~>  lower bound on the step size: (positive value)
+   IF (rcntrl(1) == zero)THEN
+      hmin = zero
+   ELSEIF (rcntrl(1)> zero)THEN
+      hmin = rcntrl(1)
+   ELSE
+      PRINT *,'User-selected Hmin: RCNTRL(1) =',RCNTRL(1)
+      CALL ros_errormsg(- 3, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  upper bound on the step size: (positive value)
+   IF (rcntrl(2) == zero)THEN
+      hmax = abs(tend-tstart)
+   ELSEIF (rcntrl(2)> zero)THEN
+      hmax = min(abs(rcntrl(2)), abs(tend-tstart))
+   ELSE
+      PRINT *,'User-selected Hmax: RCNTRL(2) =',RCNTRL(2)
+      CALL ros_errormsg(- 3, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  starting step size: (positive value)
+   IF (rcntrl(3) == zero)THEN
+      hstart = max(hmin, deltamin)
+   ELSEIF (rcntrl(3)> zero)THEN
+      hstart = min(abs(rcntrl(3)), abs(tend-tstart))
+   ELSE
+      PRINT *,'User-selected Hstart: RCNTRL(3) =',RCNTRL(3)
+      CALL ros_errormsg(- 3, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  step size can be changed s.t.  facmin < hnew/hold < facmax
+   IF (rcntrl(4) == zero)THEN
+      facmin = 0.2_dp
+   ELSEIF (rcntrl(4)> zero)THEN
+      facmin = rcntrl(4)
+   ELSE
+      PRINT *,'User-selected FacMin: RCNTRL(4) =',RCNTRL(4)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+   IF (rcntrl(5) == zero)THEN
+      facmax = 6.0_dp
+   ELSEIF (rcntrl(5)> zero)THEN
+      facmax = rcntrl(5)
+   ELSE
+      PRINT *,'User-selected FacMax: RCNTRL(5) =',RCNTRL(5)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>   facrej: factor to decrease step after 2 succesive rejections
+   IF (rcntrl(6) == zero)THEN
+      facrej = 0.1_dp
+   ELSEIF (rcntrl(6)> zero)THEN
+      facrej = rcntrl(6)
+   ELSE
+      PRINT *,'User-selected FacRej: RCNTRL(6) =',RCNTRL(6)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>   facsafe: safety factor in the computation of new step size
+   IF (rcntrl(7) == zero)THEN
+      facsafe = 0.9_dp
+   ELSEIF (rcntrl(7)> zero)THEN
+      facsafe = rcntrl(7)
+   ELSE
+      PRINT *,'User-selected FacSafe: RCNTRL(7) =',RCNTRL(7)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  check IF tolerances are reasonable
+    DO i=1, uplimtol
+      IF ((abstol(i)<= zero).or. (reltol(i)<= 10.0_dp* roundoff)&
+         .or. (reltol(i)>= 1.0_dp))THEN
+        PRINT *,' AbsTol(',i,') = ',AbsTol(i)
+        PRINT *,' RelTol(',i,') = ',RelTol(i)
+        CALL ros_errormsg(- 5, tstart, zero, ierr)
+        RETURN
+      ENDIF
+    ENDDO
+
+
+!~~~>  CALL rosenbrock method
+   CALL ros_integrator(y, tstart, tend, texit,  &
+        abstol, reltol,                         &
+!  Integration parameters
+        autonomous, vectortol, max_no_steps,    &
+        roundoff, hmin, hmax, hstart,           &
+        facmin, facmax, facrej, facsafe,        &
+!  Error indicator
+        ierr)
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+CONTAINS !  SUBROUTINEs internal to rosenbrock
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
+ SUBROUTINE ros_errormsg(code, t, h, ierr)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
+!    Handles all error messages
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
+  
+   REAL(kind=dp), INTENT(IN):: t, h
+   INTEGER, INTENT(IN) :: code
+   INTEGER, INTENT(OUT):: ierr
+   
+   ierr = code
+   print * , &
+     'Forced exit from Rosenbrock due to the following error:' 
+     
+   select CASE (code)
+    CASE (- 1)  
+      PRINT *,'--> Improper value for maximal no of steps'
+    CASE (- 2)  
+      PRINT *,'--> Selected Rosenbrock method not implemented'
+    CASE (- 3)  
+      PRINT *,'--> Hmin/Hmax/Hstart must be positive'
+    CASE (- 4)  
+      PRINT *,'--> FacMin/FacMax/FacRej must be positive'
+    CASE (- 5)
+      PRINT *,'--> Improper tolerance values'
+    CASE (- 6)
+      PRINT *,'--> No of steps exceeds maximum bound'
+    CASE (- 7)
+      PRINT *,'--> Step size too small: T + 10*H = T',&
+            ' or H < Roundoff'
+    CASE (- 8)  
+      PRINT *,'--> Matrix is repeatedly singular'
+    CASE default
+      PRINT *,'Unknown Error code: ',Code
+   END select
+   
+   print * , "t=", t, "and h=", h
+     
+ END SUBROUTINE ros_errormsg
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ SUBROUTINE ros_integrator (y, tstart, tend, t, &
+        abstol, reltol,                         &
+!~~~> integration PARAMETERs
+        autonomous, vectortol, max_no_steps,    &
+        roundoff, hmin, hmax, hstart,           &
+        facmin, facmax, facrej, facsafe,        &
+!~~~> error indicator
+        ierr)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!   Template for the implementation of a generic Rosenbrock method
+!      defined by ros_S (no of stages)
+!      and its coefficients ros_{A,C,M,E,Alpha,Gamma}
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~> input: the initial condition at tstart; output: the solution at t
+   REAL(kind=dp), INTENT(INOUT):: y(n)
+!~~~> input: integration interval
+   REAL(kind=dp), INTENT(IN):: tstart, tend
+!~~~> output: time at which the solution is RETURNed (t=tendIF success)
+   REAL(kind=dp), INTENT(OUT)::  t
+!~~~> input: tolerances
+   REAL(kind=dp), INTENT(IN)::  abstol(n), reltol(n)
+!~~~> input: integration PARAMETERs
+   LOGICAL, INTENT(IN):: autonomous, vectortol
+   REAL(kind=dp), INTENT(IN):: hstart, hmin, hmax
+   INTEGER, INTENT(IN):: max_no_steps
+   REAL(kind=dp), INTENT(IN):: roundoff, facmin, facmax, facrej, facsafe
+!~~~> output: error indicator
+   INTEGER, INTENT(OUT):: ierr
+! ~~~~ Local variables
+   REAL(kind=dp):: ynew(n), fcn0(n), fcn(n)
+   REAL(kind=dp):: k(n* ros_s), dfdt(n)
+#ifdef full_algebra    
+   REAL(kind=dp):: jac0(n, n), ghimj(n, n)
+#else
+   REAL(kind=dp):: jac0(lu_nonzero), ghimj(lu_nonzero)
+#endif
+   REAL(kind=dp):: h, hnew, hc, hg, fac, tau
+   REAL(kind=dp):: err, yerr(n)
+   INTEGER :: pivot(n), direction, ioffset, j, istage
+   LOGICAL :: rejectlasth, rejectmoreh, singular
+!~~~>  local PARAMETERs
+   REAL(kind=dp), PARAMETER :: zero = 0.0_dp, one  = 1.0_dp
+   REAL(kind=dp), PARAMETER :: deltamin = 1.0e-5_dp
+!~~~>  locally called FUNCTIONs
+!    REAL(kind=dp) WLAMCH
+!    EXTERNAL WLAMCH
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~>  initial preparations
+   t = tstart
+   rstatus(nhexit) = zero
+   h = min( max(abs(hmin), abs(hstart)), abs(hmax))
+   IF (abs(h)<= 10.0_dp* roundoff)h = deltamin
+
+   IF (tend  >=  tstart)THEN
+     direction = + 1
+   ELSE
+     direction = - 1
+   ENDIF
+   h = direction* h
+
+   rejectlasth=.FALSE.
+   rejectmoreh=.FALSE.
+
+!~~~> time loop begins below
+
+timeloop: DO WHILE((direction > 0).and.((t- tend) + roundoff <= zero)&
+       .or. (direction < 0).and.((tend-t) + roundoff <= zero))
+
+   IF (istatus(nstp)> max_no_steps)THEN  ! too many steps
+      CALL ros_errormsg(- 6, t, h, ierr)
+      RETURN
+   ENDIF
+   IF (((t+ 0.1_dp* h) == t).or.(h <= roundoff))THEN  ! step size too small
+      CALL ros_errormsg(- 7, t, h, ierr)
+      RETURN
+   ENDIF
+
+!~~~>  limit h IF necessary to avoid going beyond tend
+   h = min(h, abs(tend-t))
+
+!~~~>   compute the FUNCTION at current time
+   CALL funtemplate(t, y, fcn0)
+   istatus(nfun) = istatus(nfun) + 1
+
+!~~~>  compute the FUNCTION derivative with respect to t
+   IF (.not.autonomous)THEN
+      CALL ros_funtimederivative(t, roundoff, y, &
+                fcn0, dfdt)
+   ENDIF
+
+!~~~>   compute the jacobian at current time
+   CALL jactemplate(t, y, jac0)
+   istatus(njac) = istatus(njac) + 1
+
+!~~~>  repeat step calculation until current step accepted
+untilaccepted: do
+
+   CALL ros_preparematrix(h, direction, ros_gamma(1), &
+          jac0, ghimj, pivot, singular)
+   IF (singular)THEN ! more than 5 consecutive failed decompositions
+       CALL ros_errormsg(- 8, t, h, ierr)
+       RETURN
+   ENDIF
+
+!~~~>   compute the stages
+stage: DO istage = 1, ros_s
+
+      ! current istage offset. current istage vector is k(ioffset+ 1:ioffset+ n)
+       ioffset = n* (istage-1)
+
+      ! for the 1st istage the FUNCTION has been computed previously
+       IF (istage == 1)THEN
+         !slim: CALL wcopy(n, fcn0, 1, fcn, 1)
+       fcn(1:n) = fcn0(1:n)
+      ! istage>1 and a new FUNCTION evaluation is needed at the current istage
+       ELSEIF(ros_newf(istage))THEN
+         !slim: CALL wcopy(n, y, 1, ynew, 1)
+       ynew(1:n) = y(1:n)
+         DO j = 1, istage-1
+           CALL waxpy(n, ros_a((istage-1) * (istage-2) /2+ j), &
+            k(n* (j- 1) + 1), 1, ynew, 1)
+         ENDDO
+         tau = t + ros_alpha(istage) * direction* h
+         CALL funtemplate(tau, ynew, fcn)
+         istatus(nfun) = istatus(nfun) + 1
+       ENDIF ! IF istage == 1 ELSEIF ros_newf(istage)
+       !slim: CALL wcopy(n, fcn, 1, k(ioffset+ 1), 1)
+       k(ioffset+ 1:ioffset+ n) = fcn(1:n)
+       DO j = 1, istage-1
+         hc = ros_c((istage-1) * (istage-2) /2+ j) /(direction* h)
+         CALL waxpy(n, hc, k(n* (j- 1) + 1), 1, k(ioffset+ 1), 1)
+       ENDDO
+       IF ((.not. autonomous).and.(ros_gamma(istage).ne.zero))THEN
+         hg = direction* h* ros_gamma(istage)
+         CALL waxpy(n, hg, dfdt, 1, k(ioffset+ 1), 1)
+       ENDIF
+       CALL ros_solve(ghimj, pivot, k(ioffset+ 1))
+
+   END DO stage
+
+
+!~~~>  compute the new solution
+   !slim: CALL wcopy(n, y, 1, ynew, 1)
+   ynew(1:n) = y(1:n)
+   DO j=1, ros_s
+         CALL waxpy(n, ros_m(j), k(n* (j- 1) + 1), 1, ynew, 1)
+   ENDDO
+
+!~~~>  compute the error estimation
+   !slim: CALL wscal(n, zero, yerr, 1)
+   yerr(1:n) = zero
+   DO j=1, ros_s
+        CALL waxpy(n, ros_e(j), k(n* (j- 1) + 1), 1, yerr, 1)
+   ENDDO
+   err = ros_errornorm(y, ynew, yerr, abstol, reltol, vectortol)
+
+!~~~> new step size is bounded by facmin <= hnew/h <= facmax
+   fac  = min(facmax, max(facmin, facsafe/err** (one/ros_elo)))
+   hnew = h* fac
+
+!~~~>  check the error magnitude and adjust step size
+   istatus(nstp) = istatus(nstp) + 1
+   IF ((err <= one).or.(h <= hmin))THEN  !~~~> accept step
+      istatus(nacc) = istatus(nacc) + 1
+      !slim: CALL wcopy(n, ynew, 1, y, 1)
+      y(1:n) = ynew(1:n)
+      t = t + direction* h
+      hnew = max(hmin, min(hnew, hmax))
+      IF (rejectlasth)THEN  ! no step size increase after a rejected step
+         hnew = min(hnew, h)
+      ENDIF
+      rstatus(nhexit) = h
+      rstatus(nhnew) = hnew
+      rstatus(ntexit) = t
+      rejectlasth = .FALSE.
+      rejectmoreh = .FALSE.
+      h = hnew
+      exit untilaccepted ! exit the loop: WHILE step not accepted
+   ELSE           !~~~> reject step
+      IF (rejectmoreh)THEN
+         hnew = h* facrej
+      ENDIF
+      rejectmoreh = rejectlasth
+      rejectlasth = .TRUE.
+      h = hnew
+      IF (istatus(nacc)>= 1) istatus(nrej) = istatus(nrej) + 1
+   ENDIF ! err <= 1
+
+   END DO untilaccepted
+
+   END DO timeloop
+
+!~~~> succesful exit
+   ierr = 1  !~~~> the integration was successful
+
+  END SUBROUTINE ros_integrator
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  REAL(kind=dp)FUNCTION ros_errornorm(y, ynew, yerr, &
+                               abstol, reltol, vectortol)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> computes the "scaled norm" of the error vector yerr
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+! Input arguments
+   REAL(kind=dp), INTENT(IN):: y(n), ynew(n), &
+          yerr(n), abstol(n), reltol(n)
+   LOGICAL, INTENT(IN)::  vectortol
+! Local variables
+   REAL(kind=dp):: err, scale, ymax
+   INTEGER  :: i
+   REAL(kind=dp), PARAMETER :: zero = 0.0_dp
+
+   err = zero
+   DO i=1, n
+     ymax = max(abs(y(i)), abs(ynew(i)))
+     IF (vectortol)THEN
+       scale = abstol(i) + reltol(i) * ymax
+     ELSE
+       scale = abstol(1) + reltol(1) * ymax
+     ENDIF
+     err = err+ (yerr(i) /scale) ** 2
+   ENDDO
+   err  = sqrt(err/n)
+
+   ros_errornorm = max(err, 1.0d-10)
+
+  END FUNCTION ros_errornorm
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_funtimederivative(t, roundoff, y, &
+                fcn0, dfdt)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> the time partial derivative of the FUNCTION by finite differences
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+!~~~> input arguments
+   REAL(kind=dp), INTENT(IN):: t, roundoff, y(n), fcn0(n)
+!~~~> output arguments
+   REAL(kind=dp), INTENT(OUT):: dfdt(n)
+!~~~> local variables
+   REAL(kind=dp):: delta
+   REAL(kind=dp), PARAMETER :: one = 1.0_dp, deltamin = 1.0e-6_dp
+
+   delta = sqrt(roundoff) * max(deltamin, abs(t))
+   CALL funtemplate(t+ delta, y, dfdt)
+   istatus(nfun) = istatus(nfun) + 1
+   CALL waxpy(n, (- one), fcn0, 1, dfdt, 1)
+   CALL wscal(n, (one/delta), dfdt, 1)
+
+  END SUBROUTINE ros_funtimederivative
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_preparematrix(h, direction, gam, &
+             jac0, ghimj, pivot, singular)
+! --- --- --- --- --- --- --- --- --- --- --- --- ---
+!  Prepares the LHS matrix for stage calculations
+!  1.  Construct Ghimj = 1/(H*ham) - Jac0
+!      "(Gamma H) Inverse Minus Jacobian"
+!  2.  Repeat LU decomposition of Ghimj until successful.
+!       -half the step size if LU decomposition fails and retry
+!       -exit after 5 consecutive fails
+! --- --- --- --- --- --- --- --- --- --- --- --- ---
+
+!~~~> input arguments
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(IN)::  jac0(n, n)
+#else
+   REAL(kind=dp), INTENT(IN)::  jac0(lu_nonzero)
+#endif   
+   REAL(kind=dp), INTENT(IN)::  gam
+   INTEGER, INTENT(IN)::  direction
+!~~~> output arguments
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(OUT):: ghimj(n, n)
+#else
+   REAL(kind=dp), INTENT(OUT):: ghimj(lu_nonzero)
+#endif   
+   LOGICAL, INTENT(OUT)::  singular
+   INTEGER, INTENT(OUT)::  pivot(n)
+!~~~> inout arguments
+   REAL(kind=dp), INTENT(INOUT):: h   ! step size is decreased when lu fails
+!~~~> local variables
+   INTEGER  :: i, ising, nconsecutive
+   REAL(kind=dp):: ghinv
+   REAL(kind=dp), PARAMETER :: one  = 1.0_dp, half = 0.5_dp
+
+   nconsecutive = 0
+   singular = .TRUE.
+
+   DO WHILE (singular)
+
+!~~~>    construct ghimj = 1/(h* gam) - jac0
+#ifdef full_algebra    
+     !slim: CALL wcopy(n* n, jac0, 1, ghimj, 1)
+     !slim: CALL wscal(n* n, (- one), ghimj, 1)
+     ghimj = - jac0
+     ghinv = one/(direction* h* gam)
+     DO i=1, n
+       ghimj(i, i) = ghimj(i, i) + ghinv
+     ENDDO
+#else
+     !slim: CALL wcopy(lu_nonzero, jac0, 1, ghimj, 1)
+     !slim: CALL wscal(lu_nonzero, (- one), ghimj, 1)
+     ghimj(1:lu_nonzero) = - jac0(1:lu_nonzero)
+     ghinv = one/(direction* h* gam)
+     DO i=1, n
+       ghimj(lu_diag(i)) = ghimj(lu_diag(i)) + ghinv
+     ENDDO
+#endif   
+!~~~>    compute lu decomposition
+     CALL ros_decomp( ghimj, pivot, ising)
+     IF (ising == 0)THEN
+!~~~>    IF successful done
+        singular = .FALSE.
+     ELSE ! ising .ne. 0
+!~~~>    IF unsuccessful half the step size; IF 5 consecutive fails THEN RETURN
+        istatus(nsng) = istatus(nsng) + 1
+        nconsecutive = nconsecutive+1
+        singular = .TRUE.
+        PRINT*,'Warning: LU Decomposition returned ISING = ',ISING
+        IF (nconsecutive <= 5)THEN ! less than 5 consecutive failed decompositions
+           h = h* half
+        ELSE  ! more than 5 consecutive failed decompositions
+           RETURN
+        ENDIF  ! nconsecutive
+      ENDIF    ! ising
+
+   END DO ! WHILE singular
+
+  END SUBROUTINE ros_preparematrix
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_decomp( a, pivot, ising)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the LU decomposition
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> inout variables
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(INOUT):: a(n, n)
+#else   
+   REAL(kind=dp), INTENT(INOUT):: a(lu_nonzero)
+#endif
+!~~~> output variables
+   INTEGER, INTENT(OUT):: pivot(n), ising
+
+#ifdef full_algebra    
+   CALL  dgetrf( n, n, a, n, pivot, ising)
+#else   
+   CALL kppdecomp(a, ising)
+   pivot(1) = 1
+#endif
+   istatus(ndec) = istatus(ndec) + 1
+
+  END SUBROUTINE ros_decomp
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_solve( a, pivot, b)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the forward/backward substitution (using pre-computed LU decomposition)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> input variables
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(IN):: a(n, n)
+   INTEGER :: ising
+#else   
+   REAL(kind=dp), INTENT(IN):: a(lu_nonzero)
+#endif
+   INTEGER, INTENT(IN):: pivot(n)
+!~~~> inout variables
+   REAL(kind=dp), INTENT(INOUT):: b(n)
+
+#ifdef full_algebra    
+   CALL  DGETRS( 'N',N ,1,A,N,Pivot,b,N,ISING)
+   IF (info < 0)THEN
+      print* , "error in dgetrs. ising=", ising
+   ENDIF  
+#else   
+   CALL kppsolve( a, b)
+#endif
+
+   istatus(nsol) = istatus(nsol) + 1
+
+  END SUBROUTINE ros_solve
+
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros2
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! --- AN L-STABLE METHOD,2 stages,order 2
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+   double precision g
+
+    g = 1.0_dp + 1.0_dp/sqrt(2.0_dp)
+    rosmethod = rs2
+!~~~> name of the method
+    ros_Name = 'ROS-2'
+!~~~> number of stages
+    ros_s = 2
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+    ros_a(1) = (1.0_dp) /g
+    ros_c(1) = (- 2.0_dp) /g
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+    ros_newf(1) = .TRUE.
+    ros_newf(2) = .TRUE.
+!~~~> m_i = coefficients for new step solution
+    ros_m(1) = (3.0_dp) /(2.0_dp* g)
+    ros_m(2) = (1.0_dp) /(2.0_dp* g)
+! E_i = Coefficients for error estimator
+    ros_e(1) = 1.0_dp/(2.0_dp* g)
+    ros_e(2) = 1.0_dp/(2.0_dp* g)
+!~~~> ros_elo = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus one
+    ros_elo = 2.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+    ros_alpha(1) = 0.0_dp
+    ros_alpha(2) = 1.0_dp
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+    ros_gamma(1) = g
+    ros_gamma(2) = -g
+
+ END SUBROUTINE ros2
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! --- AN L-STABLE METHOD,3 stages,order 3,2 function evaluations
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+   rosmethod = rs3
+!~~~> name of the method
+   ros_Name = 'ROS-3'
+!~~~> number of stages
+   ros_s = 3
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+   ros_a(1) = 1.0_dp
+   ros_a(2) = 1.0_dp
+   ros_a(3) = 0.0_dp
+
+   ros_c(1) = - 0.10156171083877702091975600115545e+01_dp
+   ros_c(2) =  0.40759956452537699824805835358067e+01_dp
+   ros_c(3) =  0.92076794298330791242156818474003e+01_dp
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+   ros_newf(1) = .TRUE.
+   ros_newf(2) = .TRUE.
+   ros_newf(3) = .FALSE.
+!~~~> m_i = coefficients for new step solution
+   ros_m(1) =  0.1e+01_dp
+   ros_m(2) =  0.61697947043828245592553615689730e+01_dp
+   ros_m(3) = - 0.42772256543218573326238373806514_dp
+! E_i = Coefficients for error estimator
+   ros_e(1) =  0.5_dp
+   ros_e(2) = - 0.29079558716805469821718236208017e+01_dp
+   ros_e(3) =  0.22354069897811569627360909276199_dp
+!~~~> ros_elo = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus 1
+   ros_elo = 3.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+   ros_alpha(1) = 0.0_dp
+   ros_alpha(2) = 0.43586652150845899941601945119356_dp
+   ros_alpha(3) = 0.43586652150845899941601945119356_dp
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+   ros_gamma(1) = 0.43586652150845899941601945119356_dp
+   ros_gamma(2) = 0.24291996454816804366592249683314_dp
+   ros_gamma(3) = 0.21851380027664058511513169485832e+01_dp
+
+  END SUBROUTINE ros3
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros4
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     L-STABLE ROSENBROCK METHOD OF ORDER 4,WITH 4 STAGES
+!     L-STABLE EMBEDDED ROSENBROCK METHOD OF ORDER 3
+!
+!      E. HAIRER AND G. WANNER,SOLVING ORDINARY DIFFERENTIAL
+!      EQUATIONS II. STIFF AND DIFFERENTIAL-ALGEBRAIC PROBLEMS.
+!      SPRINGER SERIES IN COMPUTATIONAL MATHEMATICS,
+!      SPRINGER-VERLAG (1990)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+   rosmethod = rs4
+!~~~> name of the method
+   ros_Name = 'ROS-4'
+!~~~> number of stages
+   ros_s = 4
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+   ros_a(1) = 0.2000000000000000e+01_dp
+   ros_a(2) = 0.1867943637803922e+01_dp
+   ros_a(3) = 0.2344449711399156_dp
+   ros_a(4) = ros_a(2)
+   ros_a(5) = ros_a(3)
+   ros_a(6) = 0.0_dp
+
+   ros_c(1) = -0.7137615036412310e+01_dp
+   ros_c(2) = 0.2580708087951457e+01_dp
+   ros_c(3) = 0.6515950076447975_dp
+   ros_c(4) = -0.2137148994382534e+01_dp
+   ros_c(5) = -0.3214669691237626_dp
+   ros_c(6) = -0.6949742501781779_dp
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+   ros_newf(1) = .TRUE.
+   ros_newf(2) = .TRUE.
+   ros_newf(3) = .TRUE.
+   ros_newf(4) = .FALSE.
+!~~~> m_i = coefficients for new step solution
+   ros_m(1) = 0.2255570073418735e+01_dp
+   ros_m(2) = 0.2870493262186792_dp
+   ros_m(3) = 0.4353179431840180_dp
+   ros_m(4) = 0.1093502252409163e+01_dp
+!~~~> e_i  = coefficients for error estimator
+   ros_e(1) = -0.2815431932141155_dp
+   ros_e(2) = -0.7276199124938920e-01_dp
+   ros_e(3) = -0.1082196201495311_dp
+   ros_e(4) = -0.1093502252409163e+01_dp
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus 1
+   ros_elo  = 4.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+   ros_alpha(1) = 0.0_dp
+   ros_alpha(2) = 0.1145640000000000e+01_dp
+   ros_alpha(3) = 0.6552168638155900_dp
+   ros_alpha(4) = ros_alpha(3)
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+   ros_gamma(1) = 0.5728200000000000_dp
+   ros_gamma(2) = -0.1769193891319233e+01_dp
+   ros_gamma(3) = 0.7592633437920482_dp
+   ros_gamma(4) = -0.1049021087100450_dp
+
+  END SUBROUTINE ros4
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE rodas3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! --- A STIFFLY-STABLE METHOD,4 stages,order 3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+   rosmethod = rd3
+!~~~> name of the method
+   ros_Name = 'RODAS-3'
+!~~~> number of stages
+   ros_s = 4
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+   ros_a(1) = 0.0_dp
+   ros_a(2) = 2.0_dp
+   ros_a(3) = 0.0_dp
+   ros_a(4) = 2.0_dp
+   ros_a(5) = 0.0_dp
+   ros_a(6) = 1.0_dp
+
+   ros_c(1) = 4.0_dp
+   ros_c(2) = 1.0_dp
+   ros_c(3) = -1.0_dp
+   ros_c(4) = 1.0_dp
+   ros_c(5) = -1.0_dp
+   ros_c(6) = -(8.0_dp/3.0_dp)
+
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+   ros_newf(1) = .TRUE.
+   ros_newf(2) = .FALSE.
+   ros_newf(3) = .TRUE.
+   ros_newf(4) = .TRUE.
+!~~~> m_i = coefficients for new step solution
+   ros_m(1) = 2.0_dp
+   ros_m(2) = 0.0_dp
+   ros_m(3) = 1.0_dp
+   ros_m(4) = 1.0_dp
+!~~~> e_i  = coefficients for error estimator
+   ros_e(1) = 0.0_dp
+   ros_e(2) = 0.0_dp
+   ros_e(3) = 0.0_dp
+   ros_e(4) = 1.0_dp
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus 1
+   ros_elo  = 3.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+   ros_alpha(1) = 0.0_dp
+   ros_alpha(2) = 0.0_dp
+   ros_alpha(3) = 1.0_dp
+   ros_alpha(4) = 1.0_dp
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+   ros_gamma(1) = 0.5_dp
+   ros_gamma(2) = 1.5_dp
+   ros_gamma(3) = 0.0_dp
+   ros_gamma(4) = 0.0_dp
+
+  END SUBROUTINE rodas3
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE rodas4
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     STIFFLY-STABLE ROSENBROCK METHOD OF ORDER 4,WITH 6 STAGES
+!
+!      E. HAIRER AND G. WANNER,SOLVING ORDINARY DIFFERENTIAL
+!      EQUATIONS II. STIFF AND DIFFERENTIAL-ALGEBRAIC PROBLEMS.
+!      SPRINGER SERIES IN COMPUTATIONAL MATHEMATICS,
+!      SPRINGER-VERLAG (1996)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+    rosmethod = rd4
+!~~~> name of the method
+    ros_Name = 'RODAS-4'
+!~~~> number of stages
+    ros_s = 6
+
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+    ros_alpha(1) = 0.000_dp
+    ros_alpha(2) = 0.386_dp
+    ros_alpha(3) = 0.210_dp
+    ros_alpha(4) = 0.630_dp
+    ros_alpha(5) = 1.000_dp
+    ros_alpha(6) = 1.000_dp
+
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+    ros_gamma(1) = 0.2500000000000000_dp
+    ros_gamma(2) = -0.1043000000000000_dp
+    ros_gamma(3) = 0.1035000000000000_dp
+    ros_gamma(4) = -0.3620000000000023e-01_dp
+    ros_gamma(5) = 0.0_dp
+    ros_gamma(6) = 0.0_dp
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:  A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!                  C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+    ros_a(1) = 0.1544000000000000e+01_dp
+    ros_a(2) = 0.9466785280815826_dp
+    ros_a(3) = 0.2557011698983284_dp
+    ros_a(4) = 0.3314825187068521e+01_dp
+    ros_a(5) = 0.2896124015972201e+01_dp
+    ros_a(6) = 0.9986419139977817_dp
+    ros_a(7) = 0.1221224509226641e+01_dp
+    ros_a(8) = 0.6019134481288629e+01_dp
+    ros_a(9) = 0.1253708332932087e+02_dp
+    ros_a(10) = -0.6878860361058950_dp
+    ros_a(11) = ros_a(7)
+    ros_a(12) = ros_a(8)
+    ros_a(13) = ros_a(9)
+    ros_a(14) = ros_a(10)
+    ros_a(15) = 1.0_dp
+
+    ros_c(1) = -0.5668800000000000e+01_dp
+    ros_c(2) = -0.2430093356833875e+01_dp
+    ros_c(3) = -0.2063599157091915_dp
+    ros_c(4) = -0.1073529058151375_dp
+    ros_c(5) = -0.9594562251023355e+01_dp
+    ros_c(6) = -0.2047028614809616e+02_dp
+    ros_c(7) = 0.7496443313967647e+01_dp
+    ros_c(8) = -0.1024680431464352e+02_dp
+    ros_c(9) = -0.3399990352819905e+02_dp
+    ros_c(10) = 0.1170890893206160e+02_dp
+    ros_c(11) = 0.8083246795921522e+01_dp
+    ros_c(12) = -0.7981132988064893e+01_dp
+    ros_c(13) = -0.3152159432874371e+02_dp
+    ros_c(14) = 0.1631930543123136e+02_dp
+    ros_c(15) = -0.6058818238834054e+01_dp
+
+!~~~> m_i = coefficients for new step solution
+    ros_m(1) = ros_a(7)
+    ros_m(2) = ros_a(8)
+    ros_m(3) = ros_a(9)
+    ros_m(4) = ros_a(10)
+    ros_m(5) = 1.0_dp
+    ros_m(6) = 1.0_dp
+
+!~~~> e_i  = coefficients for error estimator
+    ros_e(1) = 0.0_dp
+    ros_e(2) = 0.0_dp
+    ros_e(3) = 0.0_dp
+    ros_e(4) = 0.0_dp
+    ros_e(5) = 0.0_dp
+    ros_e(6) = 1.0_dp
+
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+    ros_newf(1) = .TRUE.
+    ros_newf(2) = .TRUE.
+    ros_newf(3) = .TRUE.
+    ros_newf(4) = .TRUE.
+    ros_newf(5) = .TRUE.
+    ros_newf(6) = .TRUE.
+
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!        main and the embedded scheme orders plus 1
+    ros_elo = 4.0_dp
+
+  END SUBROUTINE rodas4
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE rang3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! STIFFLY-STABLE W METHOD OF ORDER 3,WITH 4 STAGES
+!
+! J. RANG and L. ANGERMANN
+! NEW ROSENBROCK W-METHODS OF ORDER 3
+! FOR PARTIAL DIFFERENTIAL ALGEBRAIC
+!        EQUATIONS OF INDEX 1                                             
+! BIT Numerical Mathematics (2005) 45: 761-787
+!  DOI: 10.1007/s10543-005-0035-y
+! Table 4.1-4.2
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+    rosmethod = rg3
+!~~~> name of the method
+    ros_Name = 'RANG-3'
+!~~~> number of stages
+    ros_s = 4
+
+    ros_a(1) = 5.09052051067020d+00;
+    ros_a(2) = 5.09052051067020d+00;
+    ros_a(3) = 0.0d0;
+    ros_a(4) = 4.97628111010787d+00;
+    ros_a(5) = 2.77268164715849d-02;
+    ros_a(6) = 2.29428036027904d-01;
+
+    ros_c(1) = - 1.16790812312283d+01;
+    ros_c(2) = - 1.64057326467367d+01;
+    ros_c(3) = - 2.77268164715850d-01;
+    ros_c(4) = - 8.38103960500476d+00;
+    ros_c(5) = - 8.48328409199343d-01;
+    ros_c(6) =  2.87009860433106d-01;
+
+    ros_m(1) =  5.22582761233094d+00;
+    ros_m(2) = - 5.56971148154165d-01;
+    ros_m(3) =  3.57979469353645d-01;
+    ros_m(4) =  1.72337398521064d+00;
+
+    ros_e(1) = - 5.16845212784040d+00;
+    ros_e(2) = - 1.26351942603842d+00;
+    ros_e(3) = - 1.11022302462516d-16;
+    ros_e(4) =  2.22044604925031d-16;
+
+    ros_alpha(1) = 0.0d00;
+    ros_alpha(2) = 2.21878746765329d+00;
+    ros_alpha(3) = 2.21878746765329d+00;
+    ros_alpha(4) = 1.55392337535788d+00;
+
+    ros_gamma(1) =  4.35866521508459d-01;
+    ros_gamma(2) = - 1.78292094614483d+00;
+    ros_gamma(3) = - 2.46541900496934d+00;
+    ros_gamma(4) = - 8.05529997906370d-01;
+
+
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+    ros_newf(1) = .TRUE.
+    ros_newf(2) = .TRUE.
+    ros_newf(3) = .TRUE.
+    ros_newf(4) = .TRUE.
+
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!        main and the embedded scheme orders plus 1
+    ros_elo = 3.0_dp
+
+  END SUBROUTINE rang3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!   End of the set of internal Rosenbrock subroutines
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END SUBROUTINE rosenbrock
+ 
+SUBROUTINE funtemplate( t, y, ydot)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the ODE function call.
+!  Updates the rate coefficients (and possibly the fixed species) at each call
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> input variables
+   REAL(kind=dp):: t, y(nvar)
+!~~~> output variables
+   REAL(kind=dp):: ydot(nvar)
+!~~~> local variables
+   REAL(kind=dp):: told
+
+   told = time
+   time = t
+   CALL fun( y, fix, rconst, ydot)
+   time = told
+
+END SUBROUTINE funtemplate
+ 
+SUBROUTINE jactemplate( t, y, jcb)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the ODE Jacobian call.
+!  Updates the rate coefficients (and possibly the fixed species) at each call
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> input variables
+    REAL(kind=dp):: t, y(nvar)
+!~~~> output variables
+#ifdef full_algebra    
+    REAL(kind=dp):: jv(lu_nonzero), jcb(nvar, nvar)
+#else
+    REAL(kind=dp):: jcb(lu_nonzero)
+#endif   
+!~~~> local variables
+    REAL(kind=dp):: told
+#ifdef full_algebra    
+    INTEGER :: i, j
+#endif   
+
+    told = time
+    time = t
+#ifdef full_algebra    
+    CALL jac_sp(y, fix, rconst, jv)
+    DO j=1, nvar
+      DO i=1, nvar
+         jcb(i, j) = 0.0_dp
+      ENDDO
+    ENDDO
+    DO i=1, lu_nonzero
+       jcb(lu_irow(i), lu_icol(i)) = jv(i)
+    ENDDO
+#else
+    CALL jac_sp( y, fix, rconst, jcb)
+#endif   
+    time = told
+
+END SUBROUTINE jactemplate
+ 
+  SUBROUTINE kppdecomp( jvs, ier)                                    
+  ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
+  !        sparse lu factorization                                    
+  ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
+  ! loop expansion generated by kp4                                   
+                                                                      
+    INTEGER  :: ier                                                   
+    REAL(kind=dp):: jvs(lu_nonzero), w(nvar), a             
+    INTEGER  :: k, kk, j, jj                                          
+                                                                      
+    a = 0.                                                            
+    ier = 0                                                           
+                                                                      
+!   i = 1
+    RETURN                                                            
+                                                                      
+  END SUBROUTINE kppdecomp                                            
+ 
+SUBROUTINE chem_gasphase_integrate (time_step_len, conc, tempi, qvapi, fakti, photo, ierrf, xnacc, xnrej, istatus, l_debug, pe, &
+                     icntrl_i, rcntrl_i) 
+                                                                    
+  IMPLICIT NONE                                                     
+                                                                    
+  REAL(dp), INTENT(IN)                  :: time_step_len           
+  REAL(dp), DIMENSION(:, :), INTENT(INOUT) :: conc                    
+  REAL(dp), DIMENSION(:, :), INTENT(IN)   :: photo                   
+  REAL(dp), DIMENSION(:), INTENT(IN)     :: tempi                   
+  REAL(dp), DIMENSION(:), INTENT(IN)     :: qvapi                   
+  REAL(dp), DIMENSION(:), INTENT(IN)     :: fakti                   
+  INTEGER, INTENT(OUT), OPTIONAL        :: ierrf(:)               
+  INTEGER, INTENT(OUT), OPTIONAL        :: xnacc(:)               
+  INTEGER, INTENT(OUT), OPTIONAL        :: xnrej(:)               
+  INTEGER, INTENT(INOUT), OPTIONAL      :: istatus(:)             
+  INTEGER, INTENT(IN), OPTIONAL         :: pe                      
+  LOGICAL, INTENT(IN), OPTIONAL         :: l_debug                 
+  INTEGER, DIMENSION(nkppctrl), INTENT(IN), OPTIONAL  :: icntrl_i         
+  REAL(dp), DIMENSION(nkppctrl), INTENT(IN), OPTIONAL  :: rcntrl_i         
+                                                                    
+  INTEGER                                 :: k   ! loop variable     
+  REAL(dp)                               :: dt                      
+  INTEGER, DIMENSION(20)                :: istatus_u               
+  INTEGER                                :: ierr_u                  
+  INTEGER                                :: istatf                  
+  INTEGER                                :: vl_dim_lo               
+                                                                    
+                                                                    
+  IF (PRESENT (istatus)) istatus = 0                             
+  IF (PRESENT (icntrl_i)) icntrl  = icntrl_i                      
+  IF (PRESENT (rcntrl_i)) rcntrl  = rcntrl_i                      
+                                                                    
+  vl_glo = size(tempi, 1)                                           
+                                                                    
+  vl_dim_lo = vl_dim                                                
+  DO k=1, vl_glo, vl_dim_lo                                           
+    is = k                                                          
+    ie = min(k+ vl_dim_lo-1, vl_glo)                                 
+    vl = ie-is+ 1                                                    
+                                                                    
+    c(:) = conc(is, :)                                            
+                                                                    
+    temp = tempi(is)                                             
+                                                                    
+    qvap = qvapi(is)                                             
+                                                                    
+    fakt = fakti(is)                                             
+                                                                    
+    CALL initialize                                                 
+                                                                    
+    phot(:) = photo(is, :)                                            
+                                                                    
+    CALL update_rconst                                              
+                                                                    
+    dt = time_step_len                                              
+                                                                    
+    ! integrate from t=0 to t=dt                                    
+    CALL integrate(0._dp, dt, icntrl, rcntrl, istatus_u = istatus_u, ierr_u=ierr_u)
+                                                                    
+                                                                    
+   IF (PRESENT(l_debug) .AND. PRESENT(pe)) THEN                       
+      IF (l_debug) CALL error_output(conc(is, :), ierr_u, pe)          
+   ENDIF                                                              
+                                                                      
+    conc(is, :) = c(:)                                                
+                                                                    
+    ! RETURN diagnostic information                                 
+                                                                    
+    IF (PRESENT(ierrf))   ierrf(is) = ierr_u                      
+    IF (PRESENT(xnacc))   xnacc(is) = istatus_u(4)               
+    IF (PRESENT(xnrej))   xnrej(is) = istatus_u(5)               
+                                                                    
+    IF (PRESENT (istatus)) THEN                                   
+      istatus(1:8) = istatus(1:8) + istatus_u(1:8)                
+    ENDIF                                                          
+                                                                    
+  END DO                                                            
+ 
+                                                                    
+! Deallocate input arrays                                           
+                                                                    
+                                                                    
+  data_loaded = .FALSE.                                             
+                                                                    
+  RETURN                                                            
+END SUBROUTINE chem_gasphase_integrate                                        
+
+END MODULE chem_gasphase_mod
+ 
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_passive1/chem_gasphase_mod.kpp
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_passive1/chem_gasphase_mod.kpp	(revision 3298)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_passive1/chem_gasphase_mod.kpp	(revision 3298)
@@ -0,0 +1,34 @@
+
+//chem_gasphase_mod.kpp
+//
+//Former revisions
+//----------------
+// $Id: chem_gasphase_mod.kpp 2459 2017-09-13 14:10:33Z forkel $
+//
+#include      passive1.spc
+#include      passive1.eqn
+#INTEGRATOR rosenbrock
+#LANGUAGE   Fortran90
+#HESSIAN    on
+#STOICMAT   on
+//
+// *******************************************************************************************
+// *** adapt the lines below occurding to the photolysis reactions of your mechanism         *
+// *** adapt the number of photolysis frequencies NPHO                                       *
+// *** adapt/extend the indices in the INTEGER, PARAMETER,PUBLIC statement below             *
+// *** adapt/extend PHOT_NAMES: Note that the order of PHOT_NAMES and the indices must match *
+// *******************************************************************************************
+//
+#INLINE F90_DATA
+  !   INLINE F90_DATA: Declaration of global variables for photolysis
+  !   REAL(kind=dp) :: phot(nphot) must eventually be moved to GLOBAL later for vector version
+  INTEGER, PARAMETER :: nphot = 1
+  !   phot Photolysis frequencies
+  REAL(kind=dp) :: phot(nphot)
+
+  INTEGER, PARAMETER,PUBLIC :: j_no2 = 1
+
+  CHARACTER(LEN=15), PARAMETER, DIMENSION(NPHOT) :: phot_names =  (/ &
+     'J_NO2          '/)
+#ENDINLINE
+
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_passive1/passive1.eqn
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_passive1/passive1.eqn	(revision 3298)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_passive1/passive1.eqn	(revision 3298)
@@ -0,0 +1,10 @@
+
+{passive1.eqn
+Former revisions
+----------------
+ $Id$
+}
+#EQUATIONS
+
+{ passive1: does nothing }
+  { 1.}  PM10 = PM10 :                   1.0_dp  ;
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_passive1/passive1.spc
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_passive1/passive1.spc	(revision 3298)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_passive1/passive1.spc	(revision 3298)
@@ -0,0 +1,19 @@
+
+{passive1.spc
+Former revisions
+----------------
+ $Id$
+}
+#include atoms
+
+ #DEFVAR
+    PM10    = ignore ;
+
+#DEFFIX
+    H2O         = H + 2O ;      {water}
+    H2          = 2H ;          {molecular hydrogen}
+    O2      = 2O ;          {molecular oxygen}
+    N2      = 2N ;          {molecular nitrogen}
+    CH4         = C + 4H ;      {methane}
+    CO2     = C + 2O ;      {carbon dioxide}
+
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_phstat/chem_gasphase_mod.f90
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_phstat/chem_gasphase_mod.f90	(revision 3298)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_phstat/chem_gasphase_mod.f90	(revision 3298)
@@ -0,0 +1,2359 @@
+MODULE chem_gasphase_mod
+ 
+!   Mechanism: phstat
+!
+!------------------------------------------------------------------------------!
+!
+! ******Module chem_gasphase_mod is automatically generated by kpp4palm ******
+!
+!   *********Please do NOT change this Code,it will be ovewritten *********
+!
+!------------------------------------------------------------------------------!
+! This file was created by KPP (http://people.cs.vt.edu/asandu/Software/Kpp/)
+! and kpp4palm (created by Klaus Ketelsen). kpp4palm is an adapted version 
+! of KP4 (JÃ¶ckel,P.,Kerkweg,A.,Pozzer,A.,Sander,R.,Tost,H.,Riede,
+! H.,Baumgaertner,A.,Gromov,S.,and Kern,B.,2010: Development cycle 2 of
+! the Modular Earth Submodel System (MESSy2),Geosci. Model Dev.,3,717-752,
+! https://doi.org/10.5194/gmd-3-717-2010). KP4 is part of the Modular Earth 
+! Submodel System (MESSy),which is is available under the  GNU General Public 
+! License (GPL).
+!
+! KPP is free software; you can redistribute it and/or modify it under the terms 
+! of the General Public Licence as published by the Free Software Foundation; 
+! either version 2 of the License,or (at your option) any later version. 
+! KPP is distributed in the hope that it will be useful,but WITHOUT ANY WARRANTY; 
+! without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 
+! PURPOSE. See the GNU General Public Licence for more details. 
+!
+!------------------------------------------------------------------------------!
+! This file is part of the PALM model system.
+!
+! PALM is free software: you can redistribute it and/or modify it under the
+! terms of the GNU General Public License as published by the Free Software
+! Foundation,either version 3 of the License,or (at your option) any later
+! version.
+!
+! PALM is distributed in the hope that it will be useful,but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not,see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2018 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! ------------------
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id: module_header 2460 2017-09-13 14:47:48Z forkel $
+! forkel June 2018: qvap,fakt added
+! forkel June 2018: reset case in  Initialize,Integrate,Update_rconst
+! 
+! 
+! 2460 2017-09-13 14:47:48Z forkel
+!
+! forkel Sept. 2017: Variables for photolyis added
+!
+!
+! Nov. 2016: Intial version (Klaus Ketelsen)
+!
+!------------------------------------------------------------------------------!
+!
+
+
+! Set kpp Double Precision to PALM Default Precision
+
+  USE kinds,           ONLY: dp=>wp
+
+  USE pegrid,          ONLY: myid, threads_per_task
+
+  IMPLICIT        NONE
+  PRIVATE
+  !SAVE  ! note: occurs again in automatically generated code ...
+
+!  PUBLIC :: IERR_NAMES
+ 
+! PUBLIC :: SPC_NAMES,EQN_NAMES,EQN_TAGS,REQ_HET,REQ_AEROSOL,REQ_PHOTRAT &
+!         ,REQ_MCFCT,IP_MAX,jname
+
+  PUBLIC :: eqn_names, phot_names, spc_names
+  PUBLIC :: nmaxfixsteps
+  PUBLIC :: atol, rtol
+  PUBLIC :: nspec, nreact
+  PUBLIC :: temp
+  PUBLIC :: qvap
+  PUBLIC :: fakt
+  PUBLIC :: phot 
+  PUBLIC :: rconst
+  PUBLIC :: nvar
+  PUBLIC :: nphot
+  PUBLIC :: vl_dim                     ! PUBLIC to ebable other MODULEs to distiguish between scalar and vec
+ 
+  PUBLIC :: initialize, integrate, update_rconst
+  PUBLIC :: chem_gasphase_integrate
+  PUBLIC :: initialize_kpp_ctrl
+
+! END OF MODULE HEADER TEMPLATE
+                                                                 
+! Variables used for vector mode                                 
+                                                                 
+  LOGICAL, PARAMETER          :: l_vector = .FALSE.            
+  INTEGER, PARAMETER          :: i_lu_di = 2
+  INTEGER, PARAMETER          :: vl_dim = 1
+  INTEGER                     :: vl                              
+                                                                 
+  INTEGER                     :: vl_glo                          
+  INTEGER                     :: is, ie                           
+                                                                 
+                                                                 
+  INTEGER, DIMENSION(vl_dim)  :: kacc, krej                       
+  INTEGER, DIMENSION(vl_dim)  :: ierrv                           
+  LOGICAL                     :: data_loaded = .FALSE.             
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Parameter Module File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Parameters.f90
+! Time                 : Tue Sep 25 18:35:04 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! NSPEC - Number of chemical species
+  INTEGER, PARAMETER :: nspec = 3 
+! NVAR - Number of Variable species
+  INTEGER, PARAMETER :: nvar = 3 
+! NVARACT - Number of Active species
+  INTEGER, PARAMETER :: nvaract = 3 
+! NFIX - Number of Fixed species
+  INTEGER, PARAMETER :: nfix = 1 
+! NREACT - Number of reactions
+  INTEGER, PARAMETER :: nreact = 2 
+! NVARST - Starting of variables in conc. vect.
+  INTEGER, PARAMETER :: nvarst = 1 
+! NFIXST - Starting of fixed in conc. vect.
+  INTEGER, PARAMETER :: nfixst = 4 
+! NONZERO - Number of nonzero entries in Jacobian
+  INTEGER, PARAMETER :: nonzero = 9 
+! LU_NONZERO - Number of nonzero entries in LU factoriz. of Jacobian
+  INTEGER, PARAMETER :: lu_nonzero = 9 
+! CNVAR - (NVAR+1) Number of elements in compressed row format
+  INTEGER, PARAMETER :: cnvar = 4 
+! CNEQN - (NREACT+1) Number stoicm elements in compressed col format
+  INTEGER, PARAMETER :: cneqn = 3 
+! NHESS - Length of Sparse Hessian
+  INTEGER, PARAMETER :: nhess = 3 
+! NMASS - Number of atoms to check mass balance
+  INTEGER, PARAMETER :: nmass = 1 
+
+! Index declaration for variable species in C and VAR
+!   VAR(ind_spc) = C(ind_spc)
+
+  INTEGER, PARAMETER, PUBLIC :: ind_o3 = 1 
+  INTEGER, PARAMETER, PUBLIC :: ind_no = 2 
+  INTEGER, PARAMETER, PUBLIC :: ind_no2 = 3 
+
+! Index declaration for fixed species in C
+!   C(ind_spc)
+
+
+! Index declaration for fixed species in FIX
+!    FIX(indf_spc) = C(ind_spc) = C(NVAR+indf_spc)
+
+
+! NJVRP - Length of sparse Jacobian JVRP
+  INTEGER, PARAMETER :: njvrp = 3 
+
+! NSTOICM - Length of Sparse Stoichiometric Matrix
+  INTEGER, PARAMETER :: nstoicm = 6 
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Global Data Module File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Global.f90
+! Time                 : Tue Sep 25 18:35:04 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! Declaration of global variables
+
+! C - Concentration of all species
+  REAL(kind=dp):: c(nspec)
+! VAR - Concentrations of variable species (global)
+  REAL(kind=dp):: var(nvar)
+! FIX - Concentrations of fixed species (global)
+  REAL(kind=dp):: fix(nfix)
+! VAR,FIX are chunks of array C
+      EQUIVALENCE( c(1), var(1))
+! RCONST - Rate constants (global)
+  REAL(kind=dp):: rconst(nreact)
+! TIME - Current integration time
+  REAL(kind=dp):: time
+! TEMP - Temperature
+  REAL(kind=dp):: temp
+! TSTART - Integration start time
+  REAL(kind=dp):: tstart
+! ATOL - Absolute tolerance
+  REAL(kind=dp):: atol(nvar)
+! RTOL - Relative tolerance
+  REAL(kind=dp):: rtol(nvar)
+! STEPMIN - Lower bound for integration step
+  REAL(kind=dp):: stepmin
+! CFACTOR - Conversion factor for concentration units
+  REAL(kind=dp):: cfactor
+
+! INLINED global variable declarations
+
+! QVAP - Water vapor
+  REAL(kind=dp):: qvap
+! FAKT - Conversion factor
+  REAL(kind=dp):: fakt
+
+
+! INLINED global variable declarations
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Sparse Jacobian Data Structures File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_JacobianSP.f90
+! Time                 : Tue Sep 25 18:35:04 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! Sparse Jacobian Data
+
+
+  INTEGER, PARAMETER, DIMENSION(9):: lu_irow =  (/ &
+       1, 1, 1, 2, 2, 2, 3, 3, 3 /) 
+
+  INTEGER, PARAMETER, DIMENSION(9):: lu_icol =  (/ &
+       1, 2, 3, 1, 2, 3, 1, 2, 3 /) 
+
+  INTEGER, PARAMETER, DIMENSION(4):: lu_crow =  (/ &
+       1, 4, 7, 10 /) 
+
+  INTEGER, PARAMETER, DIMENSION(4):: lu_diag =  (/ &
+       1, 5, 9, 10 /) 
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Utility Data Module File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Monitor.f90
+! Time                 : Tue Sep 25 18:35:04 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+  CHARACTER(len=15), PARAMETER, DIMENSION(3):: spc_names =  (/ &
+     'O3             ','NO             ','NO2            ' /)
+
+  CHARACTER(len=100), PARAMETER, DIMENSION(2):: eqn_names =  (/ &
+     '    NO2 --> O3 + NO                                                                                 ',&
+     'O3 + NO --> NO2                                                                                     ' /)
+
+! INLINED global variables
+
+  !   inline f90_data: declaration of global variables for photolysis
+  !   REAL(kind=dp):: phot(nphot)must eventually be moved to global later for 
+  INTEGER, PARAMETER :: nphot = 1
+  !   phot photolysis frequencies 
+  REAL(kind=dp):: phot(nphot)
+
+  INTEGER, PARAMETER, PUBLIC :: j_no2 = 1
+
+  CHARACTER(len=15), PARAMETER, DIMENSION(nphot):: phot_names =   (/ &
+     'J_NO2          '/)
+
+! End INLINED global variables
+
+
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+ 
+!  variable definations from  individual module headers 
+ 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Initialization File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Initialize.f90
+! Time                 : Tue Sep 25 18:35:04 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Numerical Integrator (Time-Stepping) File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Integrator.f90
+! Time                 : Tue Sep 25 18:35:04 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! INTEGRATE - Integrator routine
+!   Arguments :
+!      TIN       - Start Time for Integration
+!      TOUT      - End Time for Integration
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
+!  Rosenbrock - Implementation of several Rosenbrock methods:             !
+!               *Ros2                                                    !
+!               *Ros3                                                    !
+!               *Ros4                                                    !
+!               *Rodas3                                                  !
+!               *Rodas4                                                  !
+!  By default the code employs the KPP sparse linear algebra routines     !
+!  Compile with -DFULL_ALGEBRA to use full linear algebra (LAPACK)        !
+!                                                                         !
+!    (C)  Adrian Sandu,August 2004                                       !
+!    Virginia Polytechnic Institute and State University                  !
+!    Contact: sandu@cs.vt.edu                                             !
+!    Revised by Philipp Miehe and Adrian Sandu,May 2006                  !                               !
+!    This implementation is part of KPP - the Kinetic PreProcessor        !
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
+
+
+  SAVE
+  
+!~~~>  statistics on the work performed by the rosenbrock method
+  INTEGER, PARAMETER :: nfun=1, njac=2, nstp=3, nacc=4, &
+                        nrej=5, ndec=6, nsol=7, nsng=8, &
+                        ntexit=1, nhexit=2, nhnew = 3
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Linear Algebra Data and Routines File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_LinearAlgebra.f90
+! Time                 : Tue Sep 25 18:35:04 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! The ODE Jacobian of Chemical Model File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Jacobian.f90
+! Time                 : Tue Sep 25 18:35:04 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! The ODE Function of Chemical Model File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Function.f90
+! Time                 : Tue Sep 25 18:35:04 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+! A - Rate for each equation
+  REAL(kind=dp):: a(nreact)
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! The Reaction Rates File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Rates.f90
+! Time                 : Tue Sep 25 18:35:04 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Auxiliary Routines File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Util.f90
+! Time                 : Tue Sep 25 18:35:04 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+  ! header MODULE initialize_kpp_ctrl_template
+
+  ! notes:
+  ! - l_vector is automatically defined by kp4
+  ! - vl_dim is automatically defined by kp4
+  ! - i_lu_di is automatically defined by kp4
+  ! - wanted is automatically defined by xmecca
+  ! - icntrl rcntrl are automatically defined by kpp
+  ! - "USE messy_main_tools" is in MODULE_header of messy_mecca_kpp.f90
+  ! - SAVE will be automatically added by kp4
+
+  !SAVE
+
+  ! for fixed time step control
+  ! ... max. number of fixed time steps (sum must be 1)
+  INTEGER, PARAMETER         :: nmaxfixsteps = 50
+  ! ... switch for fixed time stepping
+  LOGICAL, PUBLIC            :: l_fixed_step = .FALSE.
+  INTEGER, PUBLIC            :: nfsteps = 1
+  ! ... number of kpp control PARAMETERs
+  INTEGER, PARAMETER, PUBLIC :: nkppctrl = 20
+  !
+  INTEGER, DIMENSION(nkppctrl), PUBLIC     :: icntrl = 0
+  REAL(dp), DIMENSION(nkppctrl), PUBLIC     :: rcntrl = 0.0_dp
+  REAL(dp), DIMENSION(nmaxfixsteps), PUBLIC :: t_steps = 0.0_dp
+
+  ! END header MODULE initialize_kpp_ctrl_template
+
+ 
+! Interface Block 
+ 
+  INTERFACE            initialize
+    MODULE PROCEDURE   initialize
+  END INTERFACE        initialize
+ 
+  INTERFACE            integrate
+    MODULE PROCEDURE   integrate
+  END INTERFACE        integrate
+ 
+  INTERFACE            fun
+    MODULE PROCEDURE   fun
+  END INTERFACE        fun
+ 
+  INTERFACE            kppsolve
+    MODULE PROCEDURE   kppsolve
+  END INTERFACE        kppsolve
+ 
+  INTERFACE            jac_sp
+    MODULE PROCEDURE   jac_sp
+  END INTERFACE        jac_sp
+ 
+  INTERFACE            k_arr
+    MODULE PROCEDURE   k_arr
+  END INTERFACE        k_arr
+ 
+  INTERFACE            update_rconst
+    MODULE PROCEDURE   update_rconst
+  END INTERFACE        update_rconst
+ 
+  INTERFACE            arr2
+    MODULE PROCEDURE   arr2
+  END INTERFACE        arr2
+ 
+  INTERFACE            initialize_kpp_ctrl
+    MODULE PROCEDURE   initialize_kpp_ctrl
+  END INTERFACE        initialize_kpp_ctrl
+ 
+  INTERFACE            error_output
+    MODULE PROCEDURE   error_output
+  END INTERFACE        error_output
+ 
+  INTERFACE            wscal
+    MODULE PROCEDURE   wscal
+  END INTERFACE        wscal
+ 
+!INTERFACE not working  INTERFACE            waxpy
+!INTERFACE not working    MODULE PROCEDURE   waxpy
+!INTERFACE not working  END INTERFACE        waxpy
+ 
+  INTERFACE            rosenbrock
+    MODULE PROCEDURE   rosenbrock
+  END INTERFACE        rosenbrock
+ 
+  INTERFACE            funtemplate
+    MODULE PROCEDURE   funtemplate
+  END INTERFACE        funtemplate
+ 
+  INTERFACE            jactemplate
+    MODULE PROCEDURE   jactemplate
+  END INTERFACE        jactemplate
+ 
+  INTERFACE            kppdecomp
+    MODULE PROCEDURE   kppdecomp
+  END INTERFACE        kppdecomp
+ 
+  INTERFACE            chem_gasphase_integrate
+    MODULE PROCEDURE   chem_gasphase_integrate
+  END INTERFACE        chem_gasphase_integrate
+ 
+ 
+ CONTAINS
+ 
+SUBROUTINE initialize()
+
+
+  INTEGER         :: j, k
+
+  INTEGER :: i
+  REAL(kind=dp):: x
+  k = is
+  cfactor = 1.000000e+00_dp
+
+  x = (0.) * cfactor
+  DO i = 1 , nvar
+  ENDDO
+
+  x = (0.) * cfactor
+  DO i = 1 , nfix
+    fix(i) = x
+  ENDDO
+
+! constant rate coefficients
+! END constant rate coefficients
+
+! INLINED initializations
+
+! End INLINED initializations
+
+      
+END SUBROUTINE initialize
+ 
+SUBROUTINE integrate( tin, tout, &
+  icntrl_u, rcntrl_u, istatus_u, rstatus_u, ierr_u)
+
+
+   REAL(kind=dp), INTENT(IN):: tin  ! start time
+   REAL(kind=dp), INTENT(IN):: tout ! END time
+   ! OPTIONAL input PARAMETERs and statistics
+   INTEGER,      INTENT(IN), OPTIONAL :: icntrl_u(20)
+   REAL(kind=dp), INTENT(IN), OPTIONAL :: rcntrl_u(20)
+   INTEGER,      INTENT(OUT), OPTIONAL :: istatus_u(20)
+   REAL(kind=dp), INTENT(OUT), OPTIONAL :: rstatus_u(20)
+   INTEGER,      INTENT(OUT), OPTIONAL :: ierr_u
+
+   REAL(kind=dp):: rcntrl(20), rstatus(20)
+   INTEGER       :: icntrl(20), istatus(20), ierr
+
+   INTEGER, SAVE :: ntotal = 0
+
+   icntrl(:) = 0
+   rcntrl(:) = 0.0_dp
+   istatus(:) = 0
+   rstatus(:) = 0.0_dp
+
+    !~~~> fine-tune the integrator:
+   icntrl(1) = 0      ! 0 - non- autonomous, 1 - autonomous
+   icntrl(2) = 0      ! 0 - vector tolerances, 1 - scalars
+
+   ! IF OPTIONAL PARAMETERs are given, and IF they are >0, 
+   ! THEN they overwrite default settings. 
+   IF (PRESENT(icntrl_u))THEN
+     WHERE(icntrl_u(:)> 0)icntrl(:) = icntrl_u(:)
+   ENDIF
+   IF (PRESENT(rcntrl_u))THEN
+     WHERE(rcntrl_u(:)> 0)rcntrl(:) = rcntrl_u(:)
+   ENDIF
+
+
+   CALL rosenbrock(nvar, var, tin, tout,  &
+         atol, rtol,               &
+         rcntrl, icntrl, rstatus, istatus, ierr)
+
+   !~~~> debug option: show no of steps
+   ! ntotal = ntotal + istatus(nstp)
+   ! PRINT*,'NSTEPS=',ISTATUS(Nstp),' (',Ntotal,')','  O3=',VAR(ind_O3)
+
+   stepmin = rstatus(nhexit)
+   ! IF OPTIONAL PARAMETERs are given for output they 
+   ! are updated with the RETURN information
+   IF (PRESENT(istatus_u))istatus_u(:) = istatus(:)
+   IF (PRESENT(rstatus_u))rstatus_u(:) = rstatus(:)
+   IF (PRESENT(ierr_u))  ierr_u       = ierr
+
+END SUBROUTINE integrate
+ 
+SUBROUTINE fun(v, f, rct, vdot)
+
+! V - Concentrations of variable species (local)
+  REAL(kind=dp):: v(nvar)
+! F - Concentrations of fixed species (local)
+  REAL(kind=dp):: f(nfix)
+! RCT - Rate constants (local)
+  REAL(kind=dp):: rct(nreact)
+! Vdot - Time derivative of variable species concentrations
+  REAL(kind=dp):: vdot(nvar)
+
+
+! Computation of equation rates
+  a(1) = rct(1) * v(3)
+  a(2) = rct(2) * v(1) * v(2)
+
+! Aggregate function
+  vdot(1) = a(1) - a(2)
+  vdot(2) = a(1) - a(2)
+  vdot(3) = - a(1) + a(2)
+      
+END SUBROUTINE fun
+ 
+SUBROUTINE kppsolve(jvs, x)
+
+! JVS - sparse Jacobian of variables
+  REAL(kind=dp):: jvs(lu_nonzero)
+! X - Vector for variables
+  REAL(kind=dp):: x(nvar)
+
+  x(2) = x(2) - jvs(4) * x(1)
+  x(3) = x(3) - jvs(7) * x(1) - jvs(8) * x(2)
+  x(3) = x(3) / jvs(9)
+  x(2) = (x(2) - jvs(6) * x(3)) /(jvs(5))
+  x(1) = (x(1) - jvs(2) * x(2) - jvs(3) * x(3)) /(jvs(1))
+      
+END SUBROUTINE kppsolve
+ 
+SUBROUTINE jac_sp(v, f, rct, jvs)
+
+! V - Concentrations of variable species (local)
+  REAL(kind=dp):: v(nvar)
+! F - Concentrations of fixed species (local)
+  REAL(kind=dp):: f(nfix)
+! RCT - Rate constants (local)
+  REAL(kind=dp):: rct(nreact)
+! JVS - sparse Jacobian of variables
+  REAL(kind=dp):: jvs(lu_nonzero)
+
+
+! Local variables
+! B - Temporary array
+  REAL(kind=dp):: b(3)
+
+! B(1) = dA(1)/dV(3)
+  b(1) = rct(1)
+! B(2) = dA(2)/dV(1)
+  b(2) = rct(2) * v(2)
+! B(3) = dA(2)/dV(2)
+  b(3) = rct(2) * v(1)
+
+! Construct the Jacobian terms from B's
+! JVS(1) = Jac_FULL(1,1)
+  jvs(1) = - b(2)
+! JVS(2) = Jac_FULL(1,2)
+  jvs(2) = - b(3)
+! JVS(3) = Jac_FULL(1,3)
+  jvs(3) = b(1)
+! JVS(4) = Jac_FULL(2,1)
+  jvs(4) = - b(2)
+! JVS(5) = Jac_FULL(2,2)
+  jvs(5) = - b(3)
+! JVS(6) = Jac_FULL(2,3)
+  jvs(6) = b(1)
+! JVS(7) = Jac_FULL(3,1)
+  jvs(7) = b(2)
+! JVS(8) = Jac_FULL(3,2)
+  jvs(8) = b(3)
+! JVS(9) = Jac_FULL(3,3)
+  jvs(9) = - b(1)
+      
+END SUBROUTINE jac_sp
+ 
+  elemental REAL(kind=dp)FUNCTION k_arr (k_298, tdep, temp)
+    ! arrhenius FUNCTION
+
+    REAL,    INTENT(IN):: k_298 ! k at t = 298.15k
+    REAL,    INTENT(IN):: tdep  ! temperature dependence
+    REAL(kind=dp), INTENT(IN):: temp  ! temperature
+
+    intrinsic exp
+
+    k_arr = k_298 * exp(tdep* (1._dp/temp- 3.3540e-3_dp))! 1/298.15=3.3540e-3
+
+  END FUNCTION k_arr
+ 
+SUBROUTINE update_rconst()
+ INTEGER         :: k
+
+  k = is
+
+! Begin INLINED RCONST
+
+
+! End INLINED RCONST
+
+  rconst(1) = (phot(j_no2))
+  rconst(2) = (arr2(1.8e-12_dp , 1370.0_dp , temp))
+      
+END SUBROUTINE update_rconst
+ 
+!  END FUNCTION ARR2
+REAL(kind=dp)FUNCTION arr2( a0, b0, temp)
+    REAL(kind=dp):: temp
+    REAL(kind=dp):: a0, b0
+    arr2 = a0 * exp( - b0 / temp)
+END FUNCTION arr2
+ 
+SUBROUTINE initialize_kpp_ctrl(status)
+
+
+  ! i/o
+  INTEGER,         INTENT(OUT):: status
+
+  ! local
+  REAL(dp):: tsum
+  INTEGER  :: i
+
+  ! check fixed time steps
+  tsum = 0.0_dp
+  DO i=1, nmaxfixsteps
+     IF (t_steps(i)< tiny(0.0_dp))exit
+     tsum = tsum + t_steps(i)
+  ENDDO
+
+  nfsteps = i- 1
+
+  l_fixed_step = (nfsteps > 0).and.((tsum - 1.0)< tiny(0.0_dp))
+
+  IF (l_vector)THEN
+     WRITE(*,*) ' MODE             : VECTOR (LENGTH=',VL_DIM,')'
+  ELSE
+     WRITE(*,*) ' MODE             : SCALAR'
+  ENDIF
+  !
+  WRITE(*,*) ' DE-INDEXING MODE :',I_LU_DI
+  !
+  WRITE(*,*) ' ICNTRL           : ',icntrl
+  WRITE(*,*) ' RCNTRL           : ',rcntrl
+  !
+  ! note: this is ONLY meaningful for vectorized (kp4)rosenbrock- methods
+  IF (l_vector)THEN
+     IF (l_fixed_step)THEN
+        WRITE(*,*) ' TIME STEPS       : FIXED (',t_steps(1:nfsteps),')'
+     ELSE
+        WRITE(*,*) ' TIME STEPS       : AUTOMATIC'
+     ENDIF
+  ELSE
+     WRITE(*,*) ' TIME STEPS       : AUTOMATIC '//&
+          &'(t_steps (CTRL_KPP) ignored in SCALAR MODE)'
+  ENDIF
+  ! mz_pj_20070531- 
+
+  status = 0
+
+
+END SUBROUTINE initialize_kpp_ctrl
+ 
+SUBROUTINE error_output(c, ierr, pe)
+
+
+  INTEGER, INTENT(IN):: ierr
+  INTEGER, INTENT(IN):: pe
+  REAL(dp), DIMENSION(:), INTENT(IN):: c
+
+  write(6,*) 'ERROR in chem_gasphase_mod ',ierr,C(1)
+
+
+END SUBROUTINE error_output
+ 
+      SUBROUTINE wscal(n, alpha, x, incx)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+!     constant times a vector: x(1:N) <- Alpha*x(1:N) 
+!     only for incX=incY=1
+!     after BLAS
+!     replace this by the function from the optimized BLAS implementation:
+!         CALL SSCAL(N,Alpha,X,1) or  CALL DSCAL(N,Alpha,X,1)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+
+      INTEGER  :: i, incx, m, mp1, n
+      REAL(kind=dp) :: x(n), alpha
+      REAL(kind=dp), PARAMETER  :: zero=0.0_dp, one=1.0_dp
+
+      IF (alpha .eq. one)RETURN
+      IF (n .le. 0)RETURN
+
+      m = mod(n, 5)
+      IF ( m .ne. 0)THEN
+        IF (alpha .eq. (- one))THEN
+          DO i = 1, m
+            x(i) = - x(i)
+          ENDDO
+        ELSEIF (alpha .eq. zero)THEN
+          DO i = 1, m
+            x(i) = zero
+          ENDDO
+        ELSE
+          DO i = 1, m
+            x(i) = alpha* x(i)
+          ENDDO
+        ENDIF
+        IF ( n .lt. 5)RETURN
+      ENDIF
+      mp1 = m + 1
+      IF (alpha .eq. (- one))THEN
+        DO i = mp1, n, 5
+          x(i)   = - x(i)
+          x(i + 1) = - x(i + 1)
+          x(i + 2) = - x(i + 2)
+          x(i + 3) = - x(i + 3)
+          x(i + 4) = - x(i + 4)
+        ENDDO
+      ELSEIF (alpha .eq. zero)THEN
+        DO i = mp1, n, 5
+          x(i)   = zero
+          x(i + 1) = zero
+          x(i + 2) = zero
+          x(i + 3) = zero
+          x(i + 4) = zero
+        ENDDO
+      ELSE
+        DO i = mp1, n, 5
+          x(i)   = alpha* x(i)
+          x(i + 1) = alpha* x(i + 1)
+          x(i + 2) = alpha* x(i + 2)
+          x(i + 3) = alpha* x(i + 3)
+          x(i + 4) = alpha* x(i + 4)
+        ENDDO
+      ENDIF
+
+      END SUBROUTINE wscal
+ 
+      SUBROUTINE waxpy(n, alpha, x, incx, y, incy)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+!     constant times a vector plus a vector: y <- y + Alpha*x
+!     only for incX=incY=1
+!     after BLAS
+!     replace this by the function from the optimized BLAS implementation:
+!         CALL SAXPY(N,Alpha,X,1,Y,1) or  CALL DAXPY(N,Alpha,X,1,Y,1)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+
+      INTEGER  :: i, incx, incy, m, mp1, n
+      REAL(kind=dp):: x(n), y(n), alpha
+      REAL(kind=dp), PARAMETER :: zero = 0.0_dp
+
+      IF (alpha .eq. zero)RETURN
+      IF (n .le. 0)RETURN
+
+      m = mod(n, 4)
+      IF ( m .ne. 0)THEN
+        DO i = 1, m
+          y(i) = y(i) + alpha* x(i)
+        ENDDO
+        IF ( n .lt. 4)RETURN
+      ENDIF
+      mp1 = m + 1
+      DO i = mp1, n, 4
+        y(i) = y(i) + alpha* x(i)
+        y(i + 1) = y(i + 1) + alpha* x(i + 1)
+        y(i + 2) = y(i + 2) + alpha* x(i + 2)
+        y(i + 3) = y(i + 3) + alpha* x(i + 3)
+      ENDDO
+      
+      END SUBROUTINE waxpy
+ 
+SUBROUTINE rosenbrock(n, y, tstart, tend, &
+           abstol, reltol,             &
+           rcntrl, icntrl, rstatus, istatus, ierr)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!    Solves the system y'=F(t,y) using a Rosenbrock method defined by:
+!
+!     G = 1/(H*gamma(1)) - Jac(t0,Y0)
+!     T_i = t0 + Alpha(i)*H
+!     Y_i = Y0 + \sum_{j=1}^{i-1} A(i,j)*K_j
+!     G *K_i = Fun( T_i,Y_i)+ \sum_{j=1}^S C(i,j)/H *K_j +
+!         gamma(i)*dF/dT(t0,Y0)
+!     Y1 = Y0 + \sum_{j=1}^S M(j)*K_j
+!
+!    For details on Rosenbrock methods and their implementation consult:
+!      E. Hairer and G. Wanner
+!      "Solving ODEs II. Stiff and differential-algebraic problems".
+!      Springer series in computational mathematics,Springer-Verlag,1996.
+!    The codes contained in the book inspired this implementation.
+!
+!    (C)  Adrian Sandu,August 2004
+!    Virginia Polytechnic Institute and State University
+!    Contact: sandu@cs.vt.edu
+!    Revised by Philipp Miehe and Adrian Sandu,May 2006                  
+!    This implementation is part of KPP - the Kinetic PreProcessor
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!~~~>   input arguments:
+!
+!-     y(n)  = vector of initial conditions (at t=tstart)
+!-    [tstart, tend]  = time range of integration
+!     (if Tstart>Tend the integration is performed backwards in time)
+!-    reltol, abstol = user precribed accuracy
+!- SUBROUTINE  fun( t, y, ydot) = ode FUNCTION, 
+!                       returns Ydot = Y' = F(T,Y)
+!- SUBROUTINE  jac( t, y, jcb) = jacobian of the ode FUNCTION, 
+!                       returns Jcb = dFun/dY
+!-    icntrl(1:20)  = INTEGER inputs PARAMETERs
+!-    rcntrl(1:20)  = REAL inputs PARAMETERs
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!~~~>     output arguments:
+!
+!-    y(n)  - > vector of final states (at t- >tend)
+!-    istatus(1:20) - > INTEGER output PARAMETERs
+!-    rstatus(1:20) - > REAL output PARAMETERs
+!-    ierr            - > job status upon RETURN
+!                        success (positive value) or
+!                        failure (negative value)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!~~~>     input PARAMETERs:
+!
+!    Note: For input parameters equal to zero the default values of the
+!       corresponding variables are used.
+!
+!    ICNTRL(1) = 1: F = F(y)   Independent of T (AUTONOMOUS)
+!              = 0: F = F(t,y) Depends on T (NON-AUTONOMOUS)
+!
+!    ICNTRL(2) = 0: AbsTol,RelTol are N-dimensional vectors
+!              = 1: AbsTol,RelTol are scalars
+!
+!    ICNTRL(3)  -> selection of a particular Rosenbrock method
+!        = 0 :    Rodas3 (default)
+!        = 1 :    Ros2
+!        = 2 :    Ros3
+!        = 3 :    Ros4
+!        = 4 :    Rodas3
+!        = 5 :    Rodas4
+!
+!    ICNTRL(4)  -> maximum number of integration steps
+!        For ICNTRL(4) =0) the default value of 100000 is used
+!
+!    RCNTRL(1)  -> Hmin,lower bound for the integration step size
+!          It is strongly recommended to keep Hmin = ZERO
+!    RCNTRL(2)  -> Hmax,upper bound for the integration step size
+!    RCNTRL(3)  -> Hstart,starting value for the integration step size
+!
+!    RCNTRL(4)  -> FacMin,lower bound on step decrease factor (default=0.2)
+!    RCNTRL(5)  -> FacMax,upper bound on step increase factor (default=6)
+!    RCNTRL(6)  -> FacRej,step decrease factor after multiple rejections
+!                          (default=0.1)
+!    RCNTRL(7)  -> FacSafe,by which the new step is slightly smaller
+!         than the predicted value  (default=0.9)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!
+!    OUTPUT ARGUMENTS:
+!    -----------------
+!
+!    T           -> T value for which the solution has been computed
+!                     (after successful return T=Tend).
+!
+!    Y(N)        -> Numerical solution at T
+!
+!    IDID        -> Reports on successfulness upon return:
+!                    = 1 for success
+!                    < 0 for error (value equals error code)
+!
+!    ISTATUS(1)  -> No. of function calls
+!    ISTATUS(2)  -> No. of jacobian calls
+!    ISTATUS(3)  -> No. of steps
+!    ISTATUS(4)  -> No. of accepted steps
+!    ISTATUS(5)  -> No. of rejected steps (except at very beginning)
+!    ISTATUS(6)  -> No. of LU decompositions
+!    ISTATUS(7)  -> No. of forward/backward substitutions
+!    ISTATUS(8)  -> No. of singular matrix decompositions
+!
+!    RSTATUS(1)  -> Texit,the time corresponding to the
+!                     computed Y upon return
+!    RSTATUS(2)  -> Hexit,last accepted step before exit
+!    RSTATUS(3)  -> Hnew,last predicted step (not yet taken)
+!                   For multiple restarts,use Hnew as Hstart 
+!                     in the subsequent run
+!
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~>  arguments
+   INTEGER,      INTENT(IN)  :: n
+   REAL(kind=dp), INTENT(INOUT):: y(n)
+   REAL(kind=dp), INTENT(IN)  :: tstart, tend
+   REAL(kind=dp), INTENT(IN)  :: abstol(n), reltol(n)
+   INTEGER,      INTENT(IN)  :: icntrl(20)
+   REAL(kind=dp), INTENT(IN)  :: rcntrl(20)
+   INTEGER,      INTENT(INOUT):: istatus(20)
+   REAL(kind=dp), INTENT(INOUT):: rstatus(20)
+   INTEGER, INTENT(OUT) :: ierr
+!~~~>  PARAMETERs of the rosenbrock method, up to 6 stages
+   INTEGER ::  ros_s, rosmethod
+   INTEGER, PARAMETER :: rs2=1, rs3=2, rs4=3, rd3=4, rd4=5, rg3=6
+   REAL(kind=dp):: ros_a(15), ros_c(15), ros_m(6), ros_e(6), &
+                    ros_alpha(6), ros_gamma(6), ros_elo
+   LOGICAL :: ros_newf(6)
+   CHARACTER(len=12):: ros_name
+!~~~>  local variables
+   REAL(kind=dp):: roundoff, facmin, facmax, facrej, facsafe
+   REAL(kind=dp):: hmin, hmax, hstart
+   REAL(kind=dp):: texit
+   INTEGER       :: i, uplimtol, max_no_steps
+   LOGICAL       :: autonomous, vectortol
+!~~~>   PARAMETERs
+   REAL(kind=dp), PARAMETER :: zero = 0.0_dp, one  = 1.0_dp
+   REAL(kind=dp), PARAMETER :: deltamin = 1.0e-5_dp
+
+!~~~>  initialize statistics
+   istatus(1:8) = 0
+   rstatus(1:3) = zero
+
+!~~~>  autonomous or time dependent ode. default is time dependent.
+   autonomous = .not.(icntrl(1) == 0)
+
+!~~~>  for scalar tolerances (icntrl(2).ne.0) the code uses abstol(1)and reltol(1)
+!   For Vector tolerances (ICNTRL(2) == 0) the code uses AbsTol(1:N) and RelTol(1:N)
+   IF (icntrl(2) == 0)THEN
+      vectortol = .TRUE.
+      uplimtol  = n
+   ELSE
+      vectortol = .FALSE.
+      uplimtol  = 1
+   ENDIF
+
+!~~~>   initialize the particular rosenbrock method selected
+   select CASE (icntrl(3))
+     CASE (1)
+       CALL ros2
+     CASE (2)
+       CALL ros3
+     CASE (3)
+       CALL ros4
+     CASE (0, 4)
+       CALL rodas3
+     CASE (5)
+       CALL rodas4
+     CASE (6)
+       CALL rang3
+     CASE default
+       PRINT *,'Unknown Rosenbrock method: ICNTRL(3) =',ICNTRL(3) 
+       CALL ros_errormsg(- 2, tstart, zero, ierr)
+       RETURN
+   END select
+
+!~~~>   the maximum number of steps admitted
+   IF (icntrl(4) == 0)THEN
+      max_no_steps = 200000
+   ELSEIF (icntrl(4)> 0)THEN
+      max_no_steps=icntrl(4)
+   ELSE
+      PRINT *,'User-selected max no. of steps: ICNTRL(4) =',ICNTRL(4)
+      CALL ros_errormsg(- 1, tstart, zero, ierr)
+      RETURN
+   ENDIF
+
+!~~~>  unit roundoff (1+ roundoff>1)
+   roundoff = epsilon(one)
+
+!~~~>  lower bound on the step size: (positive value)
+   IF (rcntrl(1) == zero)THEN
+      hmin = zero
+   ELSEIF (rcntrl(1)> zero)THEN
+      hmin = rcntrl(1)
+   ELSE
+      PRINT *,'User-selected Hmin: RCNTRL(1) =',RCNTRL(1)
+      CALL ros_errormsg(- 3, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  upper bound on the step size: (positive value)
+   IF (rcntrl(2) == zero)THEN
+      hmax = abs(tend-tstart)
+   ELSEIF (rcntrl(2)> zero)THEN
+      hmax = min(abs(rcntrl(2)), abs(tend-tstart))
+   ELSE
+      PRINT *,'User-selected Hmax: RCNTRL(2) =',RCNTRL(2)
+      CALL ros_errormsg(- 3, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  starting step size: (positive value)
+   IF (rcntrl(3) == zero)THEN
+      hstart = max(hmin, deltamin)
+   ELSEIF (rcntrl(3)> zero)THEN
+      hstart = min(abs(rcntrl(3)), abs(tend-tstart))
+   ELSE
+      PRINT *,'User-selected Hstart: RCNTRL(3) =',RCNTRL(3)
+      CALL ros_errormsg(- 3, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  step size can be changed s.t.  facmin < hnew/hold < facmax
+   IF (rcntrl(4) == zero)THEN
+      facmin = 0.2_dp
+   ELSEIF (rcntrl(4)> zero)THEN
+      facmin = rcntrl(4)
+   ELSE
+      PRINT *,'User-selected FacMin: RCNTRL(4) =',RCNTRL(4)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+   IF (rcntrl(5) == zero)THEN
+      facmax = 6.0_dp
+   ELSEIF (rcntrl(5)> zero)THEN
+      facmax = rcntrl(5)
+   ELSE
+      PRINT *,'User-selected FacMax: RCNTRL(5) =',RCNTRL(5)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>   facrej: factor to decrease step after 2 succesive rejections
+   IF (rcntrl(6) == zero)THEN
+      facrej = 0.1_dp
+   ELSEIF (rcntrl(6)> zero)THEN
+      facrej = rcntrl(6)
+   ELSE
+      PRINT *,'User-selected FacRej: RCNTRL(6) =',RCNTRL(6)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>   facsafe: safety factor in the computation of new step size
+   IF (rcntrl(7) == zero)THEN
+      facsafe = 0.9_dp
+   ELSEIF (rcntrl(7)> zero)THEN
+      facsafe = rcntrl(7)
+   ELSE
+      PRINT *,'User-selected FacSafe: RCNTRL(7) =',RCNTRL(7)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  check IF tolerances are reasonable
+    DO i=1, uplimtol
+      IF ((abstol(i)<= zero).or. (reltol(i)<= 10.0_dp* roundoff)&
+         .or. (reltol(i)>= 1.0_dp))THEN
+        PRINT *,' AbsTol(',i,') = ',AbsTol(i)
+        PRINT *,' RelTol(',i,') = ',RelTol(i)
+        CALL ros_errormsg(- 5, tstart, zero, ierr)
+        RETURN
+      ENDIF
+    ENDDO
+
+
+!~~~>  CALL rosenbrock method
+   CALL ros_integrator(y, tstart, tend, texit,  &
+        abstol, reltol,                         &
+!  Integration parameters
+        autonomous, vectortol, max_no_steps,    &
+        roundoff, hmin, hmax, hstart,           &
+        facmin, facmax, facrej, facsafe,        &
+!  Error indicator
+        ierr)
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+CONTAINS !  SUBROUTINEs internal to rosenbrock
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
+ SUBROUTINE ros_errormsg(code, t, h, ierr)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
+!    Handles all error messages
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
+  
+   REAL(kind=dp), INTENT(IN):: t, h
+   INTEGER, INTENT(IN) :: code
+   INTEGER, INTENT(OUT):: ierr
+   
+   ierr = code
+   print * , &
+     'Forced exit from Rosenbrock due to the following error:' 
+     
+   select CASE (code)
+    CASE (- 1)  
+      PRINT *,'--> Improper value for maximal no of steps'
+    CASE (- 2)  
+      PRINT *,'--> Selected Rosenbrock method not implemented'
+    CASE (- 3)  
+      PRINT *,'--> Hmin/Hmax/Hstart must be positive'
+    CASE (- 4)  
+      PRINT *,'--> FacMin/FacMax/FacRej must be positive'
+    CASE (- 5)
+      PRINT *,'--> Improper tolerance values'
+    CASE (- 6)
+      PRINT *,'--> No of steps exceeds maximum bound'
+    CASE (- 7)
+      PRINT *,'--> Step size too small: T + 10*H = T',&
+            ' or H < Roundoff'
+    CASE (- 8)  
+      PRINT *,'--> Matrix is repeatedly singular'
+    CASE default
+      PRINT *,'Unknown Error code: ',Code
+   END select
+   
+   print * , "t=", t, "and h=", h
+     
+ END SUBROUTINE ros_errormsg
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ SUBROUTINE ros_integrator (y, tstart, tend, t, &
+        abstol, reltol,                         &
+!~~~> integration PARAMETERs
+        autonomous, vectortol, max_no_steps,    &
+        roundoff, hmin, hmax, hstart,           &
+        facmin, facmax, facrej, facsafe,        &
+!~~~> error indicator
+        ierr)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!   Template for the implementation of a generic Rosenbrock method
+!      defined by ros_S (no of stages)
+!      and its coefficients ros_{A,C,M,E,Alpha,Gamma}
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~> input: the initial condition at tstart; output: the solution at t
+   REAL(kind=dp), INTENT(INOUT):: y(n)
+!~~~> input: integration interval
+   REAL(kind=dp), INTENT(IN):: tstart, tend
+!~~~> output: time at which the solution is RETURNed (t=tendIF success)
+   REAL(kind=dp), INTENT(OUT)::  t
+!~~~> input: tolerances
+   REAL(kind=dp), INTENT(IN)::  abstol(n), reltol(n)
+!~~~> input: integration PARAMETERs
+   LOGICAL, INTENT(IN):: autonomous, vectortol
+   REAL(kind=dp), INTENT(IN):: hstart, hmin, hmax
+   INTEGER, INTENT(IN):: max_no_steps
+   REAL(kind=dp), INTENT(IN):: roundoff, facmin, facmax, facrej, facsafe
+!~~~> output: error indicator
+   INTEGER, INTENT(OUT):: ierr
+! ~~~~ Local variables
+   REAL(kind=dp):: ynew(n), fcn0(n), fcn(n)
+   REAL(kind=dp):: k(n* ros_s), dfdt(n)
+#ifdef full_algebra    
+   REAL(kind=dp):: jac0(n, n), ghimj(n, n)
+#else
+   REAL(kind=dp):: jac0(lu_nonzero), ghimj(lu_nonzero)
+#endif
+   REAL(kind=dp):: h, hnew, hc, hg, fac, tau
+   REAL(kind=dp):: err, yerr(n)
+   INTEGER :: pivot(n), direction, ioffset, j, istage
+   LOGICAL :: rejectlasth, rejectmoreh, singular
+!~~~>  local PARAMETERs
+   REAL(kind=dp), PARAMETER :: zero = 0.0_dp, one  = 1.0_dp
+   REAL(kind=dp), PARAMETER :: deltamin = 1.0e-5_dp
+!~~~>  locally called FUNCTIONs
+!    REAL(kind=dp) WLAMCH
+!    EXTERNAL WLAMCH
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~>  initial preparations
+   t = tstart
+   rstatus(nhexit) = zero
+   h = min( max(abs(hmin), abs(hstart)), abs(hmax))
+   IF (abs(h)<= 10.0_dp* roundoff)h = deltamin
+
+   IF (tend  >=  tstart)THEN
+     direction = + 1
+   ELSE
+     direction = - 1
+   ENDIF
+   h = direction* h
+
+   rejectlasth=.FALSE.
+   rejectmoreh=.FALSE.
+
+!~~~> time loop begins below
+
+timeloop: DO WHILE((direction > 0).and.((t- tend) + roundoff <= zero)&
+       .or. (direction < 0).and.((tend-t) + roundoff <= zero))
+
+   IF (istatus(nstp)> max_no_steps)THEN  ! too many steps
+      CALL ros_errormsg(- 6, t, h, ierr)
+      RETURN
+   ENDIF
+   IF (((t+ 0.1_dp* h) == t).or.(h <= roundoff))THEN  ! step size too small
+      CALL ros_errormsg(- 7, t, h, ierr)
+      RETURN
+   ENDIF
+
+!~~~>  limit h IF necessary to avoid going beyond tend
+   h = min(h, abs(tend-t))
+
+!~~~>   compute the FUNCTION at current time
+   CALL funtemplate(t, y, fcn0)
+   istatus(nfun) = istatus(nfun) + 1
+
+!~~~>  compute the FUNCTION derivative with respect to t
+   IF (.not.autonomous)THEN
+      CALL ros_funtimederivative(t, roundoff, y, &
+                fcn0, dfdt)
+   ENDIF
+
+!~~~>   compute the jacobian at current time
+   CALL jactemplate(t, y, jac0)
+   istatus(njac) = istatus(njac) + 1
+
+!~~~>  repeat step calculation until current step accepted
+untilaccepted: do
+
+   CALL ros_preparematrix(h, direction, ros_gamma(1), &
+          jac0, ghimj, pivot, singular)
+   IF (singular)THEN ! more than 5 consecutive failed decompositions
+       CALL ros_errormsg(- 8, t, h, ierr)
+       RETURN
+   ENDIF
+
+!~~~>   compute the stages
+stage: DO istage = 1, ros_s
+
+      ! current istage offset. current istage vector is k(ioffset+ 1:ioffset+ n)
+       ioffset = n* (istage-1)
+
+      ! for the 1st istage the FUNCTION has been computed previously
+       IF (istage == 1)THEN
+         !slim: CALL wcopy(n, fcn0, 1, fcn, 1)
+       fcn(1:n) = fcn0(1:n)
+      ! istage>1 and a new FUNCTION evaluation is needed at the current istage
+       ELSEIF(ros_newf(istage))THEN
+         !slim: CALL wcopy(n, y, 1, ynew, 1)
+       ynew(1:n) = y(1:n)
+         DO j = 1, istage-1
+           CALL waxpy(n, ros_a((istage-1) * (istage-2) /2+ j), &
+            k(n* (j- 1) + 1), 1, ynew, 1)
+         ENDDO
+         tau = t + ros_alpha(istage) * direction* h
+         CALL funtemplate(tau, ynew, fcn)
+         istatus(nfun) = istatus(nfun) + 1
+       ENDIF ! IF istage == 1 ELSEIF ros_newf(istage)
+       !slim: CALL wcopy(n, fcn, 1, k(ioffset+ 1), 1)
+       k(ioffset+ 1:ioffset+ n) = fcn(1:n)
+       DO j = 1, istage-1
+         hc = ros_c((istage-1) * (istage-2) /2+ j) /(direction* h)
+         CALL waxpy(n, hc, k(n* (j- 1) + 1), 1, k(ioffset+ 1), 1)
+       ENDDO
+       IF ((.not. autonomous).and.(ros_gamma(istage).ne.zero))THEN
+         hg = direction* h* ros_gamma(istage)
+         CALL waxpy(n, hg, dfdt, 1, k(ioffset+ 1), 1)
+       ENDIF
+       CALL ros_solve(ghimj, pivot, k(ioffset+ 1))
+
+   END DO stage
+
+
+!~~~>  compute the new solution
+   !slim: CALL wcopy(n, y, 1, ynew, 1)
+   ynew(1:n) = y(1:n)
+   DO j=1, ros_s
+         CALL waxpy(n, ros_m(j), k(n* (j- 1) + 1), 1, ynew, 1)
+   ENDDO
+
+!~~~>  compute the error estimation
+   !slim: CALL wscal(n, zero, yerr, 1)
+   yerr(1:n) = zero
+   DO j=1, ros_s
+        CALL waxpy(n, ros_e(j), k(n* (j- 1) + 1), 1, yerr, 1)
+   ENDDO
+   err = ros_errornorm(y, ynew, yerr, abstol, reltol, vectortol)
+
+!~~~> new step size is bounded by facmin <= hnew/h <= facmax
+   fac  = min(facmax, max(facmin, facsafe/err** (one/ros_elo)))
+   hnew = h* fac
+
+!~~~>  check the error magnitude and adjust step size
+   istatus(nstp) = istatus(nstp) + 1
+   IF ((err <= one).or.(h <= hmin))THEN  !~~~> accept step
+      istatus(nacc) = istatus(nacc) + 1
+      !slim: CALL wcopy(n, ynew, 1, y, 1)
+      y(1:n) = ynew(1:n)
+      t = t + direction* h
+      hnew = max(hmin, min(hnew, hmax))
+      IF (rejectlasth)THEN  ! no step size increase after a rejected step
+         hnew = min(hnew, h)
+      ENDIF
+      rstatus(nhexit) = h
+      rstatus(nhnew) = hnew
+      rstatus(ntexit) = t
+      rejectlasth = .FALSE.
+      rejectmoreh = .FALSE.
+      h = hnew
+      exit untilaccepted ! exit the loop: WHILE step not accepted
+   ELSE           !~~~> reject step
+      IF (rejectmoreh)THEN
+         hnew = h* facrej
+      ENDIF
+      rejectmoreh = rejectlasth
+      rejectlasth = .TRUE.
+      h = hnew
+      IF (istatus(nacc)>= 1) istatus(nrej) = istatus(nrej) + 1
+   ENDIF ! err <= 1
+
+   END DO untilaccepted
+
+   END DO timeloop
+
+!~~~> succesful exit
+   ierr = 1  !~~~> the integration was successful
+
+  END SUBROUTINE ros_integrator
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  REAL(kind=dp)FUNCTION ros_errornorm(y, ynew, yerr, &
+                               abstol, reltol, vectortol)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> computes the "scaled norm" of the error vector yerr
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+! Input arguments
+   REAL(kind=dp), INTENT(IN):: y(n), ynew(n), &
+          yerr(n), abstol(n), reltol(n)
+   LOGICAL, INTENT(IN)::  vectortol
+! Local variables
+   REAL(kind=dp):: err, scale, ymax
+   INTEGER  :: i
+   REAL(kind=dp), PARAMETER :: zero = 0.0_dp
+
+   err = zero
+   DO i=1, n
+     ymax = max(abs(y(i)), abs(ynew(i)))
+     IF (vectortol)THEN
+       scale = abstol(i) + reltol(i) * ymax
+     ELSE
+       scale = abstol(1) + reltol(1) * ymax
+     ENDIF
+     err = err+ (yerr(i) /scale) ** 2
+   ENDDO
+   err  = sqrt(err/n)
+
+   ros_errornorm = max(err, 1.0d-10)
+
+  END FUNCTION ros_errornorm
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_funtimederivative(t, roundoff, y, &
+                fcn0, dfdt)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> the time partial derivative of the FUNCTION by finite differences
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+!~~~> input arguments
+   REAL(kind=dp), INTENT(IN):: t, roundoff, y(n), fcn0(n)
+!~~~> output arguments
+   REAL(kind=dp), INTENT(OUT):: dfdt(n)
+!~~~> local variables
+   REAL(kind=dp):: delta
+   REAL(kind=dp), PARAMETER :: one = 1.0_dp, deltamin = 1.0e-6_dp
+
+   delta = sqrt(roundoff) * max(deltamin, abs(t))
+   CALL funtemplate(t+ delta, y, dfdt)
+   istatus(nfun) = istatus(nfun) + 1
+   CALL waxpy(n, (- one), fcn0, 1, dfdt, 1)
+   CALL wscal(n, (one/delta), dfdt, 1)
+
+  END SUBROUTINE ros_funtimederivative
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_preparematrix(h, direction, gam, &
+             jac0, ghimj, pivot, singular)
+! --- --- --- --- --- --- --- --- --- --- --- --- ---
+!  Prepares the LHS matrix for stage calculations
+!  1.  Construct Ghimj = 1/(H*ham) - Jac0
+!      "(Gamma H) Inverse Minus Jacobian"
+!  2.  Repeat LU decomposition of Ghimj until successful.
+!       -half the step size if LU decomposition fails and retry
+!       -exit after 5 consecutive fails
+! --- --- --- --- --- --- --- --- --- --- --- --- ---
+
+!~~~> input arguments
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(IN)::  jac0(n, n)
+#else
+   REAL(kind=dp), INTENT(IN)::  jac0(lu_nonzero)
+#endif   
+   REAL(kind=dp), INTENT(IN)::  gam
+   INTEGER, INTENT(IN)::  direction
+!~~~> output arguments
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(OUT):: ghimj(n, n)
+#else
+   REAL(kind=dp), INTENT(OUT):: ghimj(lu_nonzero)
+#endif   
+   LOGICAL, INTENT(OUT)::  singular
+   INTEGER, INTENT(OUT)::  pivot(n)
+!~~~> inout arguments
+   REAL(kind=dp), INTENT(INOUT):: h   ! step size is decreased when lu fails
+!~~~> local variables
+   INTEGER  :: i, ising, nconsecutive
+   REAL(kind=dp):: ghinv
+   REAL(kind=dp), PARAMETER :: one  = 1.0_dp, half = 0.5_dp
+
+   nconsecutive = 0
+   singular = .TRUE.
+
+   DO WHILE (singular)
+
+!~~~>    construct ghimj = 1/(h* gam) - jac0
+#ifdef full_algebra    
+     !slim: CALL wcopy(n* n, jac0, 1, ghimj, 1)
+     !slim: CALL wscal(n* n, (- one), ghimj, 1)
+     ghimj = - jac0
+     ghinv = one/(direction* h* gam)
+     DO i=1, n
+       ghimj(i, i) = ghimj(i, i) + ghinv
+     ENDDO
+#else
+     !slim: CALL wcopy(lu_nonzero, jac0, 1, ghimj, 1)
+     !slim: CALL wscal(lu_nonzero, (- one), ghimj, 1)
+     ghimj(1:lu_nonzero) = - jac0(1:lu_nonzero)
+     ghinv = one/(direction* h* gam)
+     DO i=1, n
+       ghimj(lu_diag(i)) = ghimj(lu_diag(i)) + ghinv
+     ENDDO
+#endif   
+!~~~>    compute lu decomposition
+     CALL ros_decomp( ghimj, pivot, ising)
+     IF (ising == 0)THEN
+!~~~>    IF successful done
+        singular = .FALSE.
+     ELSE ! ising .ne. 0
+!~~~>    IF unsuccessful half the step size; IF 5 consecutive fails THEN RETURN
+        istatus(nsng) = istatus(nsng) + 1
+        nconsecutive = nconsecutive+1
+        singular = .TRUE.
+        PRINT*,'Warning: LU Decomposition returned ISING = ',ISING
+        IF (nconsecutive <= 5)THEN ! less than 5 consecutive failed decompositions
+           h = h* half
+        ELSE  ! more than 5 consecutive failed decompositions
+           RETURN
+        ENDIF  ! nconsecutive
+      ENDIF    ! ising
+
+   END DO ! WHILE singular
+
+  END SUBROUTINE ros_preparematrix
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_decomp( a, pivot, ising)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the LU decomposition
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> inout variables
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(INOUT):: a(n, n)
+#else   
+   REAL(kind=dp), INTENT(INOUT):: a(lu_nonzero)
+#endif
+!~~~> output variables
+   INTEGER, INTENT(OUT):: pivot(n), ising
+
+#ifdef full_algebra    
+   CALL  dgetrf( n, n, a, n, pivot, ising)
+#else   
+   CALL kppdecomp(a, ising)
+   pivot(1) = 1
+#endif
+   istatus(ndec) = istatus(ndec) + 1
+
+  END SUBROUTINE ros_decomp
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_solve( a, pivot, b)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the forward/backward substitution (using pre-computed LU decomposition)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> input variables
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(IN):: a(n, n)
+   INTEGER :: ising
+#else   
+   REAL(kind=dp), INTENT(IN):: a(lu_nonzero)
+#endif
+   INTEGER, INTENT(IN):: pivot(n)
+!~~~> inout variables
+   REAL(kind=dp), INTENT(INOUT):: b(n)
+
+#ifdef full_algebra    
+   CALL  DGETRS( 'N',N ,1,A,N,Pivot,b,N,ISING)
+   IF (info < 0)THEN
+      print* , "error in dgetrs. ising=", ising
+   ENDIF  
+#else   
+   CALL kppsolve( a, b)
+#endif
+
+   istatus(nsol) = istatus(nsol) + 1
+
+  END SUBROUTINE ros_solve
+
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros2
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! --- AN L-STABLE METHOD,2 stages,order 2
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+   double precision g
+
+    g = 1.0_dp + 1.0_dp/sqrt(2.0_dp)
+    rosmethod = rs2
+!~~~> name of the method
+    ros_Name = 'ROS-2'
+!~~~> number of stages
+    ros_s = 2
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+    ros_a(1) = (1.0_dp) /g
+    ros_c(1) = (- 2.0_dp) /g
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+    ros_newf(1) = .TRUE.
+    ros_newf(2) = .TRUE.
+!~~~> m_i = coefficients for new step solution
+    ros_m(1) = (3.0_dp) /(2.0_dp* g)
+    ros_m(2) = (1.0_dp) /(2.0_dp* g)
+! E_i = Coefficients for error estimator
+    ros_e(1) = 1.0_dp/(2.0_dp* g)
+    ros_e(2) = 1.0_dp/(2.0_dp* g)
+!~~~> ros_elo = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus one
+    ros_elo = 2.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+    ros_alpha(1) = 0.0_dp
+    ros_alpha(2) = 1.0_dp
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+    ros_gamma(1) = g
+    ros_gamma(2) = -g
+
+ END SUBROUTINE ros2
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! --- AN L-STABLE METHOD,3 stages,order 3,2 function evaluations
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+   rosmethod = rs3
+!~~~> name of the method
+   ros_Name = 'ROS-3'
+!~~~> number of stages
+   ros_s = 3
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+   ros_a(1) = 1.0_dp
+   ros_a(2) = 1.0_dp
+   ros_a(3) = 0.0_dp
+
+   ros_c(1) = - 0.10156171083877702091975600115545e+01_dp
+   ros_c(2) =  0.40759956452537699824805835358067e+01_dp
+   ros_c(3) =  0.92076794298330791242156818474003e+01_dp
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+   ros_newf(1) = .TRUE.
+   ros_newf(2) = .TRUE.
+   ros_newf(3) = .FALSE.
+!~~~> m_i = coefficients for new step solution
+   ros_m(1) =  0.1e+01_dp
+   ros_m(2) =  0.61697947043828245592553615689730e+01_dp
+   ros_m(3) = - 0.42772256543218573326238373806514_dp
+! E_i = Coefficients for error estimator
+   ros_e(1) =  0.5_dp
+   ros_e(2) = - 0.29079558716805469821718236208017e+01_dp
+   ros_e(3) =  0.22354069897811569627360909276199_dp
+!~~~> ros_elo = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus 1
+   ros_elo = 3.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+   ros_alpha(1) = 0.0_dp
+   ros_alpha(2) = 0.43586652150845899941601945119356_dp
+   ros_alpha(3) = 0.43586652150845899941601945119356_dp
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+   ros_gamma(1) = 0.43586652150845899941601945119356_dp
+   ros_gamma(2) = 0.24291996454816804366592249683314_dp
+   ros_gamma(3) = 0.21851380027664058511513169485832e+01_dp
+
+  END SUBROUTINE ros3
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros4
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     L-STABLE ROSENBROCK METHOD OF ORDER 4,WITH 4 STAGES
+!     L-STABLE EMBEDDED ROSENBROCK METHOD OF ORDER 3
+!
+!      E. HAIRER AND G. WANNER,SOLVING ORDINARY DIFFERENTIAL
+!      EQUATIONS II. STIFF AND DIFFERENTIAL-ALGEBRAIC PROBLEMS.
+!      SPRINGER SERIES IN COMPUTATIONAL MATHEMATICS,
+!      SPRINGER-VERLAG (1990)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+   rosmethod = rs4
+!~~~> name of the method
+   ros_Name = 'ROS-4'
+!~~~> number of stages
+   ros_s = 4
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+   ros_a(1) = 0.2000000000000000e+01_dp
+   ros_a(2) = 0.1867943637803922e+01_dp
+   ros_a(3) = 0.2344449711399156_dp
+   ros_a(4) = ros_a(2)
+   ros_a(5) = ros_a(3)
+   ros_a(6) = 0.0_dp
+
+   ros_c(1) = -0.7137615036412310e+01_dp
+   ros_c(2) = 0.2580708087951457e+01_dp
+   ros_c(3) = 0.6515950076447975_dp
+   ros_c(4) = -0.2137148994382534e+01_dp
+   ros_c(5) = -0.3214669691237626_dp
+   ros_c(6) = -0.6949742501781779_dp
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+   ros_newf(1) = .TRUE.
+   ros_newf(2) = .TRUE.
+   ros_newf(3) = .TRUE.
+   ros_newf(4) = .FALSE.
+!~~~> m_i = coefficients for new step solution
+   ros_m(1) = 0.2255570073418735e+01_dp
+   ros_m(2) = 0.2870493262186792_dp
+   ros_m(3) = 0.4353179431840180_dp
+   ros_m(4) = 0.1093502252409163e+01_dp
+!~~~> e_i  = coefficients for error estimator
+   ros_e(1) = -0.2815431932141155_dp
+   ros_e(2) = -0.7276199124938920e-01_dp
+   ros_e(3) = -0.1082196201495311_dp
+   ros_e(4) = -0.1093502252409163e+01_dp
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus 1
+   ros_elo  = 4.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+   ros_alpha(1) = 0.0_dp
+   ros_alpha(2) = 0.1145640000000000e+01_dp
+   ros_alpha(3) = 0.6552168638155900_dp
+   ros_alpha(4) = ros_alpha(3)
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+   ros_gamma(1) = 0.5728200000000000_dp
+   ros_gamma(2) = -0.1769193891319233e+01_dp
+   ros_gamma(3) = 0.7592633437920482_dp
+   ros_gamma(4) = -0.1049021087100450_dp
+
+  END SUBROUTINE ros4
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE rodas3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! --- A STIFFLY-STABLE METHOD,4 stages,order 3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+   rosmethod = rd3
+!~~~> name of the method
+   ros_Name = 'RODAS-3'
+!~~~> number of stages
+   ros_s = 4
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+   ros_a(1) = 0.0_dp
+   ros_a(2) = 2.0_dp
+   ros_a(3) = 0.0_dp
+   ros_a(4) = 2.0_dp
+   ros_a(5) = 0.0_dp
+   ros_a(6) = 1.0_dp
+
+   ros_c(1) = 4.0_dp
+   ros_c(2) = 1.0_dp
+   ros_c(3) = -1.0_dp
+   ros_c(4) = 1.0_dp
+   ros_c(5) = -1.0_dp
+   ros_c(6) = -(8.0_dp/3.0_dp)
+
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+   ros_newf(1) = .TRUE.
+   ros_newf(2) = .FALSE.
+   ros_newf(3) = .TRUE.
+   ros_newf(4) = .TRUE.
+!~~~> m_i = coefficients for new step solution
+   ros_m(1) = 2.0_dp
+   ros_m(2) = 0.0_dp
+   ros_m(3) = 1.0_dp
+   ros_m(4) = 1.0_dp
+!~~~> e_i  = coefficients for error estimator
+   ros_e(1) = 0.0_dp
+   ros_e(2) = 0.0_dp
+   ros_e(3) = 0.0_dp
+   ros_e(4) = 1.0_dp
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus 1
+   ros_elo  = 3.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+   ros_alpha(1) = 0.0_dp
+   ros_alpha(2) = 0.0_dp
+   ros_alpha(3) = 1.0_dp
+   ros_alpha(4) = 1.0_dp
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+   ros_gamma(1) = 0.5_dp
+   ros_gamma(2) = 1.5_dp
+   ros_gamma(3) = 0.0_dp
+   ros_gamma(4) = 0.0_dp
+
+  END SUBROUTINE rodas3
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE rodas4
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     STIFFLY-STABLE ROSENBROCK METHOD OF ORDER 4,WITH 6 STAGES
+!
+!      E. HAIRER AND G. WANNER,SOLVING ORDINARY DIFFERENTIAL
+!      EQUATIONS II. STIFF AND DIFFERENTIAL-ALGEBRAIC PROBLEMS.
+!      SPRINGER SERIES IN COMPUTATIONAL MATHEMATICS,
+!      SPRINGER-VERLAG (1996)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+    rosmethod = rd4
+!~~~> name of the method
+    ros_Name = 'RODAS-4'
+!~~~> number of stages
+    ros_s = 6
+
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+    ros_alpha(1) = 0.000_dp
+    ros_alpha(2) = 0.386_dp
+    ros_alpha(3) = 0.210_dp
+    ros_alpha(4) = 0.630_dp
+    ros_alpha(5) = 1.000_dp
+    ros_alpha(6) = 1.000_dp
+
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+    ros_gamma(1) = 0.2500000000000000_dp
+    ros_gamma(2) = -0.1043000000000000_dp
+    ros_gamma(3) = 0.1035000000000000_dp
+    ros_gamma(4) = -0.3620000000000023e-01_dp
+    ros_gamma(5) = 0.0_dp
+    ros_gamma(6) = 0.0_dp
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:  A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!                  C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+    ros_a(1) = 0.1544000000000000e+01_dp
+    ros_a(2) = 0.9466785280815826_dp
+    ros_a(3) = 0.2557011698983284_dp
+    ros_a(4) = 0.3314825187068521e+01_dp
+    ros_a(5) = 0.2896124015972201e+01_dp
+    ros_a(6) = 0.9986419139977817_dp
+    ros_a(7) = 0.1221224509226641e+01_dp
+    ros_a(8) = 0.6019134481288629e+01_dp
+    ros_a(9) = 0.1253708332932087e+02_dp
+    ros_a(10) = -0.6878860361058950_dp
+    ros_a(11) = ros_a(7)
+    ros_a(12) = ros_a(8)
+    ros_a(13) = ros_a(9)
+    ros_a(14) = ros_a(10)
+    ros_a(15) = 1.0_dp
+
+    ros_c(1) = -0.5668800000000000e+01_dp
+    ros_c(2) = -0.2430093356833875e+01_dp
+    ros_c(3) = -0.2063599157091915_dp
+    ros_c(4) = -0.1073529058151375_dp
+    ros_c(5) = -0.9594562251023355e+01_dp
+    ros_c(6) = -0.2047028614809616e+02_dp
+    ros_c(7) = 0.7496443313967647e+01_dp
+    ros_c(8) = -0.1024680431464352e+02_dp
+    ros_c(9) = -0.3399990352819905e+02_dp
+    ros_c(10) = 0.1170890893206160e+02_dp
+    ros_c(11) = 0.8083246795921522e+01_dp
+    ros_c(12) = -0.7981132988064893e+01_dp
+    ros_c(13) = -0.3152159432874371e+02_dp
+    ros_c(14) = 0.1631930543123136e+02_dp
+    ros_c(15) = -0.6058818238834054e+01_dp
+
+!~~~> m_i = coefficients for new step solution
+    ros_m(1) = ros_a(7)
+    ros_m(2) = ros_a(8)
+    ros_m(3) = ros_a(9)
+    ros_m(4) = ros_a(10)
+    ros_m(5) = 1.0_dp
+    ros_m(6) = 1.0_dp
+
+!~~~> e_i  = coefficients for error estimator
+    ros_e(1) = 0.0_dp
+    ros_e(2) = 0.0_dp
+    ros_e(3) = 0.0_dp
+    ros_e(4) = 0.0_dp
+    ros_e(5) = 0.0_dp
+    ros_e(6) = 1.0_dp
+
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+    ros_newf(1) = .TRUE.
+    ros_newf(2) = .TRUE.
+    ros_newf(3) = .TRUE.
+    ros_newf(4) = .TRUE.
+    ros_newf(5) = .TRUE.
+    ros_newf(6) = .TRUE.
+
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!        main and the embedded scheme orders plus 1
+    ros_elo = 4.0_dp
+
+  END SUBROUTINE rodas4
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE rang3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! STIFFLY-STABLE W METHOD OF ORDER 3,WITH 4 STAGES
+!
+! J. RANG and L. ANGERMANN
+! NEW ROSENBROCK W-METHODS OF ORDER 3
+! FOR PARTIAL DIFFERENTIAL ALGEBRAIC
+!        EQUATIONS OF INDEX 1                                             
+! BIT Numerical Mathematics (2005) 45: 761-787
+!  DOI: 10.1007/s10543-005-0035-y
+! Table 4.1-4.2
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+    rosmethod = rg3
+!~~~> name of the method
+    ros_Name = 'RANG-3'
+!~~~> number of stages
+    ros_s = 4
+
+    ros_a(1) = 5.09052051067020d+00;
+    ros_a(2) = 5.09052051067020d+00;
+    ros_a(3) = 0.0d0;
+    ros_a(4) = 4.97628111010787d+00;
+    ros_a(5) = 2.77268164715849d-02;
+    ros_a(6) = 2.29428036027904d-01;
+
+    ros_c(1) = - 1.16790812312283d+01;
+    ros_c(2) = - 1.64057326467367d+01;
+    ros_c(3) = - 2.77268164715850d-01;
+    ros_c(4) = - 8.38103960500476d+00;
+    ros_c(5) = - 8.48328409199343d-01;
+    ros_c(6) =  2.87009860433106d-01;
+
+    ros_m(1) =  5.22582761233094d+00;
+    ros_m(2) = - 5.56971148154165d-01;
+    ros_m(3) =  3.57979469353645d-01;
+    ros_m(4) =  1.72337398521064d+00;
+
+    ros_e(1) = - 5.16845212784040d+00;
+    ros_e(2) = - 1.26351942603842d+00;
+    ros_e(3) = - 1.11022302462516d-16;
+    ros_e(4) =  2.22044604925031d-16;
+
+    ros_alpha(1) = 0.0d00;
+    ros_alpha(2) = 2.21878746765329d+00;
+    ros_alpha(3) = 2.21878746765329d+00;
+    ros_alpha(4) = 1.55392337535788d+00;
+
+    ros_gamma(1) =  4.35866521508459d-01;
+    ros_gamma(2) = - 1.78292094614483d+00;
+    ros_gamma(3) = - 2.46541900496934d+00;
+    ros_gamma(4) = - 8.05529997906370d-01;
+
+
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+    ros_newf(1) = .TRUE.
+    ros_newf(2) = .TRUE.
+    ros_newf(3) = .TRUE.
+    ros_newf(4) = .TRUE.
+
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!        main and the embedded scheme orders plus 1
+    ros_elo = 3.0_dp
+
+  END SUBROUTINE rang3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!   End of the set of internal Rosenbrock subroutines
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END SUBROUTINE rosenbrock
+ 
+SUBROUTINE funtemplate( t, y, ydot)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the ODE function call.
+!  Updates the rate coefficients (and possibly the fixed species) at each call
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> input variables
+   REAL(kind=dp):: t, y(nvar)
+!~~~> output variables
+   REAL(kind=dp):: ydot(nvar)
+!~~~> local variables
+   REAL(kind=dp):: told
+
+   told = time
+   time = t
+   CALL fun( y, fix, rconst, ydot)
+   time = told
+
+END SUBROUTINE funtemplate
+ 
+SUBROUTINE jactemplate( t, y, jcb)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the ODE Jacobian call.
+!  Updates the rate coefficients (and possibly the fixed species) at each call
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> input variables
+    REAL(kind=dp):: t, y(nvar)
+!~~~> output variables
+#ifdef full_algebra    
+    REAL(kind=dp):: jv(lu_nonzero), jcb(nvar, nvar)
+#else
+    REAL(kind=dp):: jcb(lu_nonzero)
+#endif   
+!~~~> local variables
+    REAL(kind=dp):: told
+#ifdef full_algebra    
+    INTEGER :: i, j
+#endif   
+
+    told = time
+    time = t
+#ifdef full_algebra    
+    CALL jac_sp(y, fix, rconst, jv)
+    DO j=1, nvar
+      DO i=1, nvar
+         jcb(i, j) = 0.0_dp
+      ENDDO
+    ENDDO
+    DO i=1, lu_nonzero
+       jcb(lu_irow(i), lu_icol(i)) = jv(i)
+    ENDDO
+#else
+    CALL jac_sp( y, fix, rconst, jcb)
+#endif   
+    time = told
+
+END SUBROUTINE jactemplate
+ 
+  SUBROUTINE kppdecomp( jvs, ier)                                    
+  ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
+  !        sparse lu factorization                                    
+  ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
+  ! loop expansion generated by kp4                                   
+                                                                      
+    INTEGER  :: ier                                                   
+    REAL(kind=dp):: jvs(lu_nonzero), w(nvar), a             
+    INTEGER  :: k, kk, j, jj                                          
+                                                                      
+    a = 0.                                                            
+    ier = 0                                                           
+                                                                      
+!   i = 1
+!   i = 2
+    jvs(4) = (jvs(4)) / jvs(1) 
+    jvs(5) = jvs(5) - jvs(2) * jvs(4)
+    jvs(6) = jvs(6) - jvs(3) * jvs(4)
+!   i = 3
+    jvs(7) = (jvs(7)) / jvs(1) 
+    a = 0.0; a = a  - jvs(2) * jvs(7)
+    jvs(8) = (jvs(8) + a) / jvs(5) 
+    jvs(9) = jvs(9) - jvs(3) * jvs(7) - jvs(6) * jvs(8)
+    RETURN                                                            
+                                                                      
+  END SUBROUTINE kppdecomp                                            
+ 
+SUBROUTINE chem_gasphase_integrate (time_step_len, conc, tempi, qvapi, fakti, photo, ierrf, xnacc, xnrej, istatus, l_debug, pe, &
+                     icntrl_i, rcntrl_i) 
+                                                                    
+  IMPLICIT NONE                                                     
+                                                                    
+  REAL(dp), INTENT(IN)                  :: time_step_len           
+  REAL(dp), DIMENSION(:, :), INTENT(INOUT) :: conc                    
+  REAL(dp), DIMENSION(:, :), INTENT(IN)   :: photo                   
+  REAL(dp), DIMENSION(:), INTENT(IN)     :: tempi                   
+  REAL(dp), DIMENSION(:), INTENT(IN)     :: qvapi                   
+  REAL(dp), DIMENSION(:), INTENT(IN)     :: fakti                   
+  INTEGER, INTENT(OUT), OPTIONAL        :: ierrf(:)               
+  INTEGER, INTENT(OUT), OPTIONAL        :: xnacc(:)               
+  INTEGER, INTENT(OUT), OPTIONAL        :: xnrej(:)               
+  INTEGER, INTENT(INOUT), OPTIONAL      :: istatus(:)             
+  INTEGER, INTENT(IN), OPTIONAL         :: pe                      
+  LOGICAL, INTENT(IN), OPTIONAL         :: l_debug                 
+  INTEGER, DIMENSION(nkppctrl), INTENT(IN), OPTIONAL  :: icntrl_i         
+  REAL(dp), DIMENSION(nkppctrl), INTENT(IN), OPTIONAL  :: rcntrl_i         
+                                                                    
+  INTEGER                                 :: k   ! loop variable     
+  REAL(dp)                               :: dt                      
+  INTEGER, DIMENSION(20)                :: istatus_u               
+  INTEGER                                :: ierr_u                  
+  INTEGER                                :: istatf                  
+  INTEGER                                :: vl_dim_lo               
+                                                                    
+                                                                    
+  IF (PRESENT (istatus)) istatus = 0                             
+  IF (PRESENT (icntrl_i)) icntrl  = icntrl_i                      
+  IF (PRESENT (rcntrl_i)) rcntrl  = rcntrl_i                      
+                                                                    
+  vl_glo = size(tempi, 1)                                           
+                                                                    
+  vl_dim_lo = vl_dim                                                
+  DO k=1, vl_glo, vl_dim_lo                                           
+    is = k                                                          
+    ie = min(k+ vl_dim_lo-1, vl_glo)                                 
+    vl = ie-is+ 1                                                    
+                                                                    
+    c(:) = conc(is, :)                                            
+                                                                    
+    temp = tempi(is)                                             
+                                                                    
+    qvap = qvapi(is)                                             
+                                                                    
+    fakt = fakti(is)                                             
+                                                                    
+    CALL initialize                                                 
+                                                                    
+    phot(:) = photo(is, :)                                            
+                                                                    
+    CALL update_rconst                                              
+                                                                    
+    dt = time_step_len                                              
+                                                                    
+    ! integrate from t=0 to t=dt                                    
+    CALL integrate(0._dp, dt, icntrl, rcntrl, istatus_u = istatus_u, ierr_u=ierr_u)
+                                                                    
+                                                                    
+   IF (PRESENT(l_debug) .AND. PRESENT(pe)) THEN                       
+      IF (l_debug) CALL error_output(conc(is, :), ierr_u, pe)          
+   ENDIF                                                              
+                                                                      
+    conc(is, :) = c(:)                                                
+                                                                    
+    ! RETURN diagnostic information                                 
+                                                                    
+    IF (PRESENT(ierrf))   ierrf(is) = ierr_u                      
+    IF (PRESENT(xnacc))   xnacc(is) = istatus_u(4)               
+    IF (PRESENT(xnrej))   xnrej(is) = istatus_u(5)               
+                                                                    
+    IF (PRESENT (istatus)) THEN                                   
+      istatus(1:8) = istatus(1:8) + istatus_u(1:8)                
+    ENDIF                                                          
+                                                                    
+  END DO                                                            
+ 
+                                                                    
+! Deallocate input arrays                                           
+                                                                    
+                                                                    
+  data_loaded = .FALSE.                                             
+                                                                    
+  RETURN                                                            
+END SUBROUTINE chem_gasphase_integrate                                        
+
+END MODULE chem_gasphase_mod
+ 
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_phstat/chem_gasphase_mod.kpp
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_phstat/chem_gasphase_mod.kpp	(revision 3298)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_phstat/chem_gasphase_mod.kpp	(revision 3298)
@@ -0,0 +1,32 @@
+//chem_gasphase_mod.kpp
+//
+//Former revisions
+//----------------
+// $Id: chem_gasphase_mod.kpp 2459 2017-09-13 14:10:33Z forkel $
+//
+#include      phstat.spc
+#include      phstat.eqn
+#INTEGRATOR rosenbrock
+#LANGUAGE   Fortran90
+#HESSIAN    on
+#STOICMAT   on
+//
+// *******************************************************************************************
+// *** adapt the lines below occurding to the photolysis reactions of your mechanism         *
+// *** adapt the number of photolysis frequencies NPHO                                       *
+// *** adapt/extend the indices in the INTEGER, PARAMETER,PUBLIC statement below             *
+// *** adapt/extend PHOT_NAMES: Note that the order of PHOT_NAMES and the indices must match *
+// *******************************************************************************************
+//
+#INLINE F90_DATA
+  !   INLINE F90_DATA: Declaration of global variables for photolysis
+  !   REAL(kind=dp) :: phot(nphot) must eventually be moved to GLOBAL later for vector version
+  INTEGER, PARAMETER :: nphot = 1
+  !   phot Photolysis frequencies 
+  REAL(kind=dp) :: phot(nphot)
+
+  INTEGER, PARAMETER,PUBLIC :: j_no2 = 1
+
+  CHARACTER(LEN=15), PARAMETER, DIMENSION(NPHOT) :: phot_names =  (/ &
+     'J_NO2          '/)
+#ENDINLINE
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_phstat/phstat.eqn
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_phstat/phstat.eqn	(revision 3298)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_phstat/phstat.eqn	(revision 3298)
@@ -0,0 +1,9 @@
+{phstat.eqn
+Current revision
+----------------
+ 20180319 Photostationary O3-NO-NO2-equilibrium forkel
+}
+#EQUATIONS
+
+  { 1.}  NO2 + hv = NO + O3 :                   phot(j_no2)  ;
+  { 3.}  NO + O3 = NO2 :                     arr2(1.8E-12_dp, 1370.0_dp, temp) ;
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_phstat/phstat.spc
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_phstat/phstat.spc	(revision 3298)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_phstat/phstat.spc	(revision 3298)
@@ -0,0 +1,19 @@
+{phstat.spc
+Former revisions
+----------------
+ $Id: smog.spc 2459 2017-09-13 14:10:33Z forkel $
+}
+#include atoms
+
+ #DEFVAR  
+    O       = O ;      		{oxygen atomic ground state (3P)}
+    O3		= 3O ;          {ozone}  
+    NO		= N + O ;       {nitric oxide}  
+    NO2		= N + 2O ;      {nitrogen dioxide} 
+
+#DEFFIX
+    H2O		= H + 2O ;      {water}
+    H2		= 2H ;          {molecular hydrogen}
+    O2      = 2O ;          {molecular oxygen}              
+    N2      = 2N ;          {molecular nitrogen}              
+
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_simple/chem_gasphase_mod.f90
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_simple/chem_gasphase_mod.f90	(revision 3298)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_simple/chem_gasphase_mod.f90	(revision 3298)
@@ -0,0 +1,2513 @@
+MODULE chem_gasphase_mod
+ 
+!   Mechanism: simple
+!
+!------------------------------------------------------------------------------!
+!
+! ******Module chem_gasphase_mod is automatically generated by kpp4palm ******
+!
+!   *********Please do NOT change this Code,it will be ovewritten *********
+!
+!------------------------------------------------------------------------------!
+! This file was created by KPP (http://people.cs.vt.edu/asandu/Software/Kpp/)
+! and kpp4palm (created by Klaus Ketelsen). kpp4palm is an adapted version 
+! of KP4 (JÃ¶ckel,P.,Kerkweg,A.,Pozzer,A.,Sander,R.,Tost,H.,Riede,
+! H.,Baumgaertner,A.,Gromov,S.,and Kern,B.,2010: Development cycle 2 of
+! the Modular Earth Submodel System (MESSy2),Geosci. Model Dev.,3,717-752,
+! https://doi.org/10.5194/gmd-3-717-2010). KP4 is part of the Modular Earth 
+! Submodel System (MESSy),which is is available under the  GNU General Public 
+! License (GPL).
+!
+! KPP is free software; you can redistribute it and/or modify it under the terms 
+! of the General Public Licence as published by the Free Software Foundation; 
+! either version 2 of the License,or (at your option) any later version. 
+! KPP is distributed in the hope that it will be useful,but WITHOUT ANY WARRANTY; 
+! without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 
+! PURPOSE. See the GNU General Public Licence for more details. 
+!
+!------------------------------------------------------------------------------!
+! This file is part of the PALM model system.
+!
+! PALM is free software: you can redistribute it and/or modify it under the
+! terms of the GNU General Public License as published by the Free Software
+! Foundation,either version 3 of the License,or (at your option) any later
+! version.
+!
+! PALM is distributed in the hope that it will be useful,but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not,see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2018 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! ------------------
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id: module_header 2460 2017-09-13 14:47:48Z forkel $
+! forkel June 2018: qvap,fakt added
+! forkel June 2018: reset case in  Initialize,Integrate,Update_rconst
+! 
+! 
+! 2460 2017-09-13 14:47:48Z forkel
+!
+! forkel Sept. 2017: Variables for photolyis added
+!
+!
+! Nov. 2016: Intial version (Klaus Ketelsen)
+!
+!------------------------------------------------------------------------------!
+!
+
+
+! Set kpp Double Precision to PALM Default Precision
+
+  USE kinds,           ONLY: dp=>wp
+
+  USE pegrid,          ONLY: myid, threads_per_task
+
+  IMPLICIT        NONE
+  PRIVATE
+  !SAVE  ! note: occurs again in automatically generated code ...
+
+!  PUBLIC :: IERR_NAMES
+ 
+! PUBLIC :: SPC_NAMES,EQN_NAMES,EQN_TAGS,REQ_HET,REQ_AEROSOL,REQ_PHOTRAT &
+!         ,REQ_MCFCT,IP_MAX,jname
+
+  PUBLIC :: eqn_names, phot_names, spc_names
+  PUBLIC :: nmaxfixsteps
+  PUBLIC :: atol, rtol
+  PUBLIC :: nspec, nreact
+  PUBLIC :: temp
+  PUBLIC :: qvap
+  PUBLIC :: fakt
+  PUBLIC :: phot 
+  PUBLIC :: rconst
+  PUBLIC :: nvar
+  PUBLIC :: nphot
+  PUBLIC :: vl_dim                     ! PUBLIC to ebable other MODULEs to distiguish between scalar and vec
+ 
+  PUBLIC :: initialize, integrate, update_rconst
+  PUBLIC :: chem_gasphase_integrate
+  PUBLIC :: initialize_kpp_ctrl
+
+! END OF MODULE HEADER TEMPLATE
+                                                                 
+! Variables used for vector mode                                 
+                                                                 
+  LOGICAL, PARAMETER          :: l_vector = .FALSE.            
+  INTEGER, PARAMETER          :: i_lu_di = 2
+  INTEGER, PARAMETER          :: vl_dim = 1
+  INTEGER                     :: vl                              
+                                                                 
+  INTEGER                     :: vl_glo                          
+  INTEGER                     :: is, ie                           
+                                                                 
+                                                                 
+  INTEGER, DIMENSION(vl_dim)  :: kacc, krej                       
+  INTEGER, DIMENSION(vl_dim)  :: ierrv                           
+  LOGICAL                     :: data_loaded = .FALSE.             
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Parameter Module File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Parameters.f90
+! Time                 : Tue Sep 25 18:35:44 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! NSPEC - Number of chemical species
+  INTEGER, PARAMETER :: nspec = 11 
+! NVAR - Number of Variable species
+  INTEGER, PARAMETER :: nvar = 9 
+! NVARACT - Number of Active species
+  INTEGER, PARAMETER :: nvaract = 7 
+! NFIX - Number of Fixed species
+  INTEGER, PARAMETER :: nfix = 2 
+! NREACT - Number of reactions
+  INTEGER, PARAMETER :: nreact = 7 
+! NVARST - Starting of variables in conc. vect.
+  INTEGER, PARAMETER :: nvarst = 1 
+! NFIXST - Starting of fixed in conc. vect.
+  INTEGER, PARAMETER :: nfixst = 10 
+! NONZERO - Number of nonzero entries in Jacobian
+  INTEGER, PARAMETER :: nonzero = 35 
+! LU_NONZERO - Number of nonzero entries in LU factoriz. of Jacobian
+  INTEGER, PARAMETER :: lu_nonzero = 37 
+! CNVAR - (NVAR+1) Number of elements in compressed row format
+  INTEGER, PARAMETER :: cnvar = 10 
+! CNEQN - (NREACT+1) Number stoicm elements in compressed col format
+  INTEGER, PARAMETER :: cneqn = 8 
+! NHESS - Length of Sparse Hessian
+  INTEGER, PARAMETER :: nhess = 18 
+! NMASS - Number of atoms to check mass balance
+  INTEGER, PARAMETER :: nmass = 1 
+
+! Index declaration for variable species in C and VAR
+!   VAR(ind_spc) = C(ind_spc)
+
+  INTEGER, PARAMETER, PUBLIC :: ind_hno3 = 1 
+  INTEGER, PARAMETER, PUBLIC :: ind_rcho = 2 
+  INTEGER, PARAMETER, PUBLIC :: ind_rh = 3 
+  INTEGER, PARAMETER, PUBLIC :: ind_ho2 = 4 
+  INTEGER, PARAMETER, PUBLIC :: ind_ro2 = 5 
+  INTEGER, PARAMETER, PUBLIC :: ind_oh = 6 
+  INTEGER, PARAMETER, PUBLIC :: ind_no2 = 7 
+  INTEGER, PARAMETER, PUBLIC :: ind_o3 = 8 
+  INTEGER, PARAMETER, PUBLIC :: ind_no = 9 
+
+! Index declaration for fixed species in C
+!   C(ind_spc)
+
+  INTEGER, PARAMETER, PUBLIC :: ind_h2o = 10 
+  INTEGER, PARAMETER, PUBLIC :: ind_o2 = 11 
+
+! Index declaration for fixed species in FIX
+!    FIX(indf_spc) = C(ind_spc) = C(NVAR+indf_spc)
+
+  INTEGER, PARAMETER :: indf_h2o = 1 
+  INTEGER, PARAMETER :: indf_o2 = 2 
+
+! NJVRP - Length of sparse Jacobian JVRP
+  INTEGER, PARAMETER :: njvrp = 12 
+
+! NSTOICM - Length of Sparse Stoichiometric Matrix
+  INTEGER, PARAMETER :: nstoicm = 23 
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Global Data Module File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Global.f90
+! Time                 : Tue Sep 25 18:35:44 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! Declaration of global variables
+
+! C - Concentration of all species
+  REAL(kind=dp):: c(nspec)
+! VAR - Concentrations of variable species (global)
+  REAL(kind=dp):: var(nvar)
+! FIX - Concentrations of fixed species (global)
+  REAL(kind=dp):: fix(nfix)
+! VAR,FIX are chunks of array C
+      EQUIVALENCE( c(1), var(1))
+      EQUIVALENCE( c(10), fix(1))
+! RCONST - Rate constants (global)
+  REAL(kind=dp):: rconst(nreact)
+! TIME - Current integration time
+  REAL(kind=dp):: time
+! TEMP - Temperature
+  REAL(kind=dp):: temp
+! TSTART - Integration start time
+  REAL(kind=dp):: tstart
+! ATOL - Absolute tolerance
+  REAL(kind=dp):: atol(nvar)
+! RTOL - Relative tolerance
+  REAL(kind=dp):: rtol(nvar)
+! STEPMIN - Lower bound for integration step
+  REAL(kind=dp):: stepmin
+! CFACTOR - Conversion factor for concentration units
+  REAL(kind=dp):: cfactor
+
+! INLINED global variable declarations
+
+! QVAP - Water vapor
+  REAL(kind=dp):: qvap
+! FAKT - Conversion factor
+  REAL(kind=dp):: fakt
+
+
+! INLINED global variable declarations
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Sparse Jacobian Data Structures File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_JacobianSP.f90
+! Time                 : Tue Sep 25 18:35:44 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! Sparse Jacobian Data
+
+
+  INTEGER, PARAMETER, DIMENSION(37):: lu_irow =  (/ &
+       1, 1, 1, 2, 2, 2, 3, 3, 4, 4, 4, 5, &
+       5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 7, 7, &
+       7, 7, 7, 7, 8, 8, 8, 9, 9, 9, 9, 9, &
+       9 /) 
+
+  INTEGER, PARAMETER, DIMENSION(37):: lu_icol =  (/ &
+       1, 6, 7, 2, 5, 9, 3, 6, 4, 5, 9, 3, &
+       5, 6, 9, 3, 4, 5, 6, 7, 8, 9, 4, 5, &
+       6, 7, 8, 9, 7, 8, 9, 4, 5, 6, 7, 8, &
+       9 /) 
+
+  INTEGER, PARAMETER, DIMENSION(10):: lu_crow =  (/ &
+       1, 4, 7, 9, 12, 16, 23, 29, 32, 38 /) 
+
+  INTEGER, PARAMETER, DIMENSION(10):: lu_diag =  (/ &
+       1, 4, 7, 9, 13, 19, 26, 30, 37, 38 /) 
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Utility Data Module File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Monitor.f90
+! Time                 : Tue Sep 25 18:35:44 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+  CHARACTER(len=15), PARAMETER, DIMENSION(11):: spc_names =  (/ &
+     'HNO3           ','RCHO           ','RH             ',&
+     'HO2            ','RO2            ','OH             ',&
+     'NO2            ','O3             ','NO             ',&
+     'H2O            ','O2             ' /)
+
+  CHARACTER(len=100), PARAMETER, DIMENSION(7):: eqn_names =  (/ &
+     '     NO2 --> O3 + NO                                                                                ',&
+     '      O3 --> 2 OH + O2                                                                              ',&
+     ' O3 + NO --> NO2                                                                                    ',&
+     ' RH + OH --> RO2 + H2O                                                                              ',&
+     'RO2 + NO --> RCHO + HO2 + NO2                                                                       ',&
+     'HO2 + NO --> OH + NO2                                                                               ',&
+     'OH + NO2 --> HNO3                                                                                   ' /)
+
+! INLINED global variables
+
+  !   inline f90_data: declaration of global variables for photolysis
+  !   REAL(kind=dp):: phot(nphot)must eventually be moved to global later for 
+  INTEGER, PARAMETER :: nphot = 2
+  !   phot photolysis frequencies 
+  REAL(kind=dp):: phot(nphot)
+
+  INTEGER, PARAMETER, PUBLIC :: j_no2 = 1
+  INTEGER, PARAMETER, PUBLIC :: j_o31d = 2
+
+  CHARACTER(len=15), PARAMETER, DIMENSION(nphot):: phot_names =   (/ &
+     'J_NO2          ','J_O31D         '/)
+
+! End INLINED global variables
+
+
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+ 
+!  variable definations from  individual module headers 
+ 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Initialization File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Initialize.f90
+! Time                 : Tue Sep 25 18:35:44 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Numerical Integrator (Time-Stepping) File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Integrator.f90
+! Time                 : Tue Sep 25 18:35:44 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! INTEGRATE - Integrator routine
+!   Arguments :
+!      TIN       - Start Time for Integration
+!      TOUT      - End Time for Integration
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
+!  Rosenbrock - Implementation of several Rosenbrock methods:             !
+!               *Ros2                                                    !
+!               *Ros3                                                    !
+!               *Ros4                                                    !
+!               *Rodas3                                                  !
+!               *Rodas4                                                  !
+!  By default the code employs the KPP sparse linear algebra routines     !
+!  Compile with -DFULL_ALGEBRA to use full linear algebra (LAPACK)        !
+!                                                                         !
+!    (C)  Adrian Sandu,August 2004                                       !
+!    Virginia Polytechnic Institute and State University                  !
+!    Contact: sandu@cs.vt.edu                                             !
+!    Revised by Philipp Miehe and Adrian Sandu,May 2006                  !                               !
+!    This implementation is part of KPP - the Kinetic PreProcessor        !
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
+
+
+  SAVE
+  
+!~~~>  statistics on the work performed by the rosenbrock method
+  INTEGER, PARAMETER :: nfun=1, njac=2, nstp=3, nacc=4, &
+                        nrej=5, ndec=6, nsol=7, nsng=8, &
+                        ntexit=1, nhexit=2, nhnew = 3
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Linear Algebra Data and Routines File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_LinearAlgebra.f90
+! Time                 : Tue Sep 25 18:35:44 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! The ODE Jacobian of Chemical Model File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Jacobian.f90
+! Time                 : Tue Sep 25 18:35:44 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! The ODE Function of Chemical Model File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Function.f90
+! Time                 : Tue Sep 25 18:35:44 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+! A - Rate for each equation
+  REAL(kind=dp):: a(nreact)
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! The Reaction Rates File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Rates.f90
+! Time                 : Tue Sep 25 18:35:44 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Auxiliary Routines File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Util.f90
+! Time                 : Tue Sep 25 18:35:44 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+  ! header MODULE initialize_kpp_ctrl_template
+
+  ! notes:
+  ! - l_vector is automatically defined by kp4
+  ! - vl_dim is automatically defined by kp4
+  ! - i_lu_di is automatically defined by kp4
+  ! - wanted is automatically defined by xmecca
+  ! - icntrl rcntrl are automatically defined by kpp
+  ! - "USE messy_main_tools" is in MODULE_header of messy_mecca_kpp.f90
+  ! - SAVE will be automatically added by kp4
+
+  !SAVE
+
+  ! for fixed time step control
+  ! ... max. number of fixed time steps (sum must be 1)
+  INTEGER, PARAMETER         :: nmaxfixsteps = 50
+  ! ... switch for fixed time stepping
+  LOGICAL, PUBLIC            :: l_fixed_step = .FALSE.
+  INTEGER, PUBLIC            :: nfsteps = 1
+  ! ... number of kpp control PARAMETERs
+  INTEGER, PARAMETER, PUBLIC :: nkppctrl = 20
+  !
+  INTEGER, DIMENSION(nkppctrl), PUBLIC     :: icntrl = 0
+  REAL(dp), DIMENSION(nkppctrl), PUBLIC     :: rcntrl = 0.0_dp
+  REAL(dp), DIMENSION(nmaxfixsteps), PUBLIC :: t_steps = 0.0_dp
+
+  ! END header MODULE initialize_kpp_ctrl_template
+
+ 
+! Interface Block 
+ 
+  INTERFACE            initialize
+    MODULE PROCEDURE   initialize
+  END INTERFACE        initialize
+ 
+  INTERFACE            integrate
+    MODULE PROCEDURE   integrate
+  END INTERFACE        integrate
+ 
+  INTERFACE            fun
+    MODULE PROCEDURE   fun
+  END INTERFACE        fun
+ 
+  INTERFACE            kppsolve
+    MODULE PROCEDURE   kppsolve
+  END INTERFACE        kppsolve
+ 
+  INTERFACE            jac_sp
+    MODULE PROCEDURE   jac_sp
+  END INTERFACE        jac_sp
+ 
+  INTERFACE            k_arr
+    MODULE PROCEDURE   k_arr
+  END INTERFACE        k_arr
+ 
+  INTERFACE            update_rconst
+    MODULE PROCEDURE   update_rconst
+  END INTERFACE        update_rconst
+ 
+  INTERFACE            arr2
+    MODULE PROCEDURE   arr2
+  END INTERFACE        arr2
+ 
+  INTERFACE            initialize_kpp_ctrl
+    MODULE PROCEDURE   initialize_kpp_ctrl
+  END INTERFACE        initialize_kpp_ctrl
+ 
+  INTERFACE            error_output
+    MODULE PROCEDURE   error_output
+  END INTERFACE        error_output
+ 
+  INTERFACE            wscal
+    MODULE PROCEDURE   wscal
+  END INTERFACE        wscal
+ 
+!INTERFACE not working  INTERFACE            waxpy
+!INTERFACE not working    MODULE PROCEDURE   waxpy
+!INTERFACE not working  END INTERFACE        waxpy
+ 
+  INTERFACE            rosenbrock
+    MODULE PROCEDURE   rosenbrock
+  END INTERFACE        rosenbrock
+ 
+  INTERFACE            funtemplate
+    MODULE PROCEDURE   funtemplate
+  END INTERFACE        funtemplate
+ 
+  INTERFACE            jactemplate
+    MODULE PROCEDURE   jactemplate
+  END INTERFACE        jactemplate
+ 
+  INTERFACE            kppdecomp
+    MODULE PROCEDURE   kppdecomp
+  END INTERFACE        kppdecomp
+ 
+  INTERFACE            chem_gasphase_integrate
+    MODULE PROCEDURE   chem_gasphase_integrate
+  END INTERFACE        chem_gasphase_integrate
+ 
+ 
+ CONTAINS
+ 
+SUBROUTINE initialize()
+
+
+  INTEGER         :: j, k
+
+  INTEGER :: i
+  REAL(kind=dp):: x
+  k = is
+  cfactor = 1.000000e+00_dp
+
+  x = (0.) * cfactor
+  DO i = 1 , nvar
+  ENDDO
+
+  x = (0.) * cfactor
+  DO i = 1 , nfix
+    fix(i) = x
+  ENDDO
+
+! constant rate coefficients
+! END constant rate coefficients
+
+! INLINED initializations
+
+! End INLINED initializations
+
+      
+END SUBROUTINE initialize
+ 
+SUBROUTINE integrate( tin, tout, &
+  icntrl_u, rcntrl_u, istatus_u, rstatus_u, ierr_u)
+
+
+   REAL(kind=dp), INTENT(IN):: tin  ! start time
+   REAL(kind=dp), INTENT(IN):: tout ! END time
+   ! OPTIONAL input PARAMETERs and statistics
+   INTEGER,      INTENT(IN), OPTIONAL :: icntrl_u(20)
+   REAL(kind=dp), INTENT(IN), OPTIONAL :: rcntrl_u(20)
+   INTEGER,      INTENT(OUT), OPTIONAL :: istatus_u(20)
+   REAL(kind=dp), INTENT(OUT), OPTIONAL :: rstatus_u(20)
+   INTEGER,      INTENT(OUT), OPTIONAL :: ierr_u
+
+   REAL(kind=dp):: rcntrl(20), rstatus(20)
+   INTEGER       :: icntrl(20), istatus(20), ierr
+
+   INTEGER, SAVE :: ntotal = 0
+
+   icntrl(:) = 0
+   rcntrl(:) = 0.0_dp
+   istatus(:) = 0
+   rstatus(:) = 0.0_dp
+
+    !~~~> fine-tune the integrator:
+   icntrl(1) = 0      ! 0 - non- autonomous, 1 - autonomous
+   icntrl(2) = 0      ! 0 - vector tolerances, 1 - scalars
+
+   ! IF OPTIONAL PARAMETERs are given, and IF they are >0, 
+   ! THEN they overwrite default settings. 
+   IF (PRESENT(icntrl_u))THEN
+     WHERE(icntrl_u(:)> 0)icntrl(:) = icntrl_u(:)
+   ENDIF
+   IF (PRESENT(rcntrl_u))THEN
+     WHERE(rcntrl_u(:)> 0)rcntrl(:) = rcntrl_u(:)
+   ENDIF
+
+
+   CALL rosenbrock(nvar, var, tin, tout,  &
+         atol, rtol,               &
+         rcntrl, icntrl, rstatus, istatus, ierr)
+
+   !~~~> debug option: show no of steps
+   ! ntotal = ntotal + istatus(nstp)
+   ! PRINT*,'NSTEPS=',ISTATUS(Nstp),' (',Ntotal,')','  O3=',VAR(ind_O3)
+
+   stepmin = rstatus(nhexit)
+   ! IF OPTIONAL PARAMETERs are given for output they 
+   ! are updated with the RETURN information
+   IF (PRESENT(istatus_u))istatus_u(:) = istatus(:)
+   IF (PRESENT(rstatus_u))rstatus_u(:) = rstatus(:)
+   IF (PRESENT(ierr_u))  ierr_u       = ierr
+
+END SUBROUTINE integrate
+ 
+SUBROUTINE fun(v, f, rct, vdot)
+
+! V - Concentrations of variable species (local)
+  REAL(kind=dp):: v(nvar)
+! F - Concentrations of fixed species (local)
+  REAL(kind=dp):: f(nfix)
+! RCT - Rate constants (local)
+  REAL(kind=dp):: rct(nreact)
+! Vdot - Time derivative of variable species concentrations
+  REAL(kind=dp):: vdot(nvar)
+
+
+! Computation of equation rates
+  a(1) = rct(1) * v(7)
+  a(2) = rct(2) * v(8)
+  a(3) = rct(3) * v(8) * v(9)
+  a(4) = rct(4) * v(3) * v(6)
+  a(5) = rct(5) * v(5) * v(9)
+  a(6) = rct(6) * v(4) * v(9)
+  a(7) = rct(7) * v(6) * v(7)
+
+! Aggregate function
+  vdot(1) = a(7)
+  vdot(2) = a(5)
+  vdot(3) = - a(4)
+  vdot(4) = a(5) - a(6)
+  vdot(5) = a(4) - a(5)
+  vdot(6) = 2* a(2) - a(4) + a(6) - a(7)
+  vdot(7) = - a(1) + a(3) + a(5) + a(6) - a(7)
+  vdot(8) = a(1) - a(2) - a(3)
+  vdot(9) = a(1) - a(3) - a(5) - a(6)
+      
+END SUBROUTINE fun
+ 
+SUBROUTINE kppsolve(jvs, x)
+
+! JVS - sparse Jacobian of variables
+  REAL(kind=dp):: jvs(lu_nonzero)
+! X - Vector for variables
+  REAL(kind=dp):: x(nvar)
+
+  x(5) = x(5) - jvs(12) * x(3)
+  x(6) = x(6) - jvs(16) * x(3) - jvs(17) * x(4) - jvs(18) * x(5)
+  x(7) = x(7) - jvs(23) * x(4) - jvs(24) * x(5) - jvs(25) * x(6)
+  x(8) = x(8) - jvs(29) * x(7)
+  x(9) = x(9) - jvs(32) * x(4) - jvs(33) * x(5) - jvs(34) * x(6) - jvs(35) * x(7) - jvs(36) * x(8)
+  x(9) = x(9) / jvs(37)
+  x(8) = (x(8) - jvs(31) * x(9)) /(jvs(30))
+  x(7) = (x(7) - jvs(27) * x(8) - jvs(28) * x(9)) /(jvs(26))
+  x(6) = (x(6) - jvs(20) * x(7) - jvs(21) * x(8) - jvs(22) * x(9)) /(jvs(19))
+  x(5) = (x(5) - jvs(14) * x(6) - jvs(15) * x(9)) /(jvs(13))
+  x(4) = (x(4) - jvs(10) * x(5) - jvs(11) * x(9)) /(jvs(9))
+  x(3) = (x(3) - jvs(8) * x(6)) /(jvs(7))
+  x(2) = (x(2) - jvs(5) * x(5) - jvs(6) * x(9)) /(jvs(4))
+  x(1) = (x(1) - jvs(2) * x(6) - jvs(3) * x(7)) /(jvs(1))
+      
+END SUBROUTINE kppsolve
+ 
+SUBROUTINE jac_sp(v, f, rct, jvs)
+
+! V - Concentrations of variable species (local)
+  REAL(kind=dp):: v(nvar)
+! F - Concentrations of fixed species (local)
+  REAL(kind=dp):: f(nfix)
+! RCT - Rate constants (local)
+  REAL(kind=dp):: rct(nreact)
+! JVS - sparse Jacobian of variables
+  REAL(kind=dp):: jvs(lu_nonzero)
+
+
+! Local variables
+! B - Temporary array
+  REAL(kind=dp):: b(12)
+
+! B(1) = dA(1)/dV(7)
+  b(1) = rct(1)
+! B(2) = dA(2)/dV(8)
+  b(2) = rct(2)
+! B(3) = dA(3)/dV(8)
+  b(3) = rct(3) * v(9)
+! B(4) = dA(3)/dV(9)
+  b(4) = rct(3) * v(8)
+! B(5) = dA(4)/dV(3)
+  b(5) = rct(4) * v(6)
+! B(6) = dA(4)/dV(6)
+  b(6) = rct(4) * v(3)
+! B(7) = dA(5)/dV(5)
+  b(7) = rct(5) * v(9)
+! B(8) = dA(5)/dV(9)
+  b(8) = rct(5) * v(5)
+! B(9) = dA(6)/dV(4)
+  b(9) = rct(6) * v(9)
+! B(10) = dA(6)/dV(9)
+  b(10) = rct(6) * v(4)
+! B(11) = dA(7)/dV(6)
+  b(11) = rct(7) * v(7)
+! B(12) = dA(7)/dV(7)
+  b(12) = rct(7) * v(6)
+
+! Construct the Jacobian terms from B's
+! JVS(1) = Jac_FULL(1,1)
+  jvs(1) = 0
+! JVS(2) = Jac_FULL(1,6)
+  jvs(2) = b(11)
+! JVS(3) = Jac_FULL(1,7)
+  jvs(3) = b(12)
+! JVS(4) = Jac_FULL(2,2)
+  jvs(4) = 0
+! JVS(5) = Jac_FULL(2,5)
+  jvs(5) = b(7)
+! JVS(6) = Jac_FULL(2,9)
+  jvs(6) = b(8)
+! JVS(7) = Jac_FULL(3,3)
+  jvs(7) = - b(5)
+! JVS(8) = Jac_FULL(3,6)
+  jvs(8) = - b(6)
+! JVS(9) = Jac_FULL(4,4)
+  jvs(9) = - b(9)
+! JVS(10) = Jac_FULL(4,5)
+  jvs(10) = b(7)
+! JVS(11) = Jac_FULL(4,9)
+  jvs(11) = b(8) - b(10)
+! JVS(12) = Jac_FULL(5,3)
+  jvs(12) = b(5)
+! JVS(13) = Jac_FULL(5,5)
+  jvs(13) = - b(7)
+! JVS(14) = Jac_FULL(5,6)
+  jvs(14) = b(6)
+! JVS(15) = Jac_FULL(5,9)
+  jvs(15) = - b(8)
+! JVS(16) = Jac_FULL(6,3)
+  jvs(16) = - b(5)
+! JVS(17) = Jac_FULL(6,4)
+  jvs(17) = b(9)
+! JVS(18) = Jac_FULL(6,5)
+  jvs(18) = 0
+! JVS(19) = Jac_FULL(6,6)
+  jvs(19) = - b(6) - b(11)
+! JVS(20) = Jac_FULL(6,7)
+  jvs(20) = - b(12)
+! JVS(21) = Jac_FULL(6,8)
+  jvs(21) = 2* b(2)
+! JVS(22) = Jac_FULL(6,9)
+  jvs(22) = b(10)
+! JVS(23) = Jac_FULL(7,4)
+  jvs(23) = b(9)
+! JVS(24) = Jac_FULL(7,5)
+  jvs(24) = b(7)
+! JVS(25) = Jac_FULL(7,6)
+  jvs(25) = - b(11)
+! JVS(26) = Jac_FULL(7,7)
+  jvs(26) = - b(1) - b(12)
+! JVS(27) = Jac_FULL(7,8)
+  jvs(27) = b(3)
+! JVS(28) = Jac_FULL(7,9)
+  jvs(28) = b(4) + b(8) + b(10)
+! JVS(29) = Jac_FULL(8,7)
+  jvs(29) = b(1)
+! JVS(30) = Jac_FULL(8,8)
+  jvs(30) = - b(2) - b(3)
+! JVS(31) = Jac_FULL(8,9)
+  jvs(31) = - b(4)
+! JVS(32) = Jac_FULL(9,4)
+  jvs(32) = - b(9)
+! JVS(33) = Jac_FULL(9,5)
+  jvs(33) = - b(7)
+! JVS(34) = Jac_FULL(9,6)
+  jvs(34) = 0
+! JVS(35) = Jac_FULL(9,7)
+  jvs(35) = b(1)
+! JVS(36) = Jac_FULL(9,8)
+  jvs(36) = - b(3)
+! JVS(37) = Jac_FULL(9,9)
+  jvs(37) = - b(4) - b(8) - b(10)
+      
+END SUBROUTINE jac_sp
+ 
+  elemental REAL(kind=dp)FUNCTION k_arr (k_298, tdep, temp)
+    ! arrhenius FUNCTION
+
+    REAL,    INTENT(IN):: k_298 ! k at t = 298.15k
+    REAL,    INTENT(IN):: tdep  ! temperature dependence
+    REAL(kind=dp), INTENT(IN):: temp  ! temperature
+
+    intrinsic exp
+
+    k_arr = k_298 * exp(tdep* (1._dp/temp- 3.3540e-3_dp))! 1/298.15=3.3540e-3
+
+  END FUNCTION k_arr
+ 
+SUBROUTINE update_rconst()
+ INTEGER         :: k
+
+  k = is
+
+! Begin INLINED RCONST
+
+
+! End INLINED RCONST
+
+  rconst(1) = (phot(j_no2))
+  rconst(2) = (phot(j_o31d))
+  rconst(3) = (arr2(1.8e-12_dp , 1370.0_dp , temp))
+  rconst(4) = (arr2(2.e-11_dp , 500.0_dp , temp))
+  rconst(5) = (arr2(4.2e-12_dp , -180.0_dp , temp))
+  rconst(6) = (arr2(3.7e-12_dp , -240.0_dp , temp))
+  rconst(7) = (arr2(1.15e-11_dp , 0.0_dp , temp))
+      
+END SUBROUTINE update_rconst
+ 
+!  END FUNCTION ARR2
+REAL(kind=dp)FUNCTION arr2( a0, b0, temp)
+    REAL(kind=dp):: temp
+    REAL(kind=dp):: a0, b0
+    arr2 = a0 * exp( - b0 / temp)
+END FUNCTION arr2
+ 
+SUBROUTINE initialize_kpp_ctrl(status)
+
+
+  ! i/o
+  INTEGER,         INTENT(OUT):: status
+
+  ! local
+  REAL(dp):: tsum
+  INTEGER  :: i
+
+  ! check fixed time steps
+  tsum = 0.0_dp
+  DO i=1, nmaxfixsteps
+     IF (t_steps(i)< tiny(0.0_dp))exit
+     tsum = tsum + t_steps(i)
+  ENDDO
+
+  nfsteps = i- 1
+
+  l_fixed_step = (nfsteps > 0).and.((tsum - 1.0)< tiny(0.0_dp))
+
+  IF (l_vector)THEN
+     WRITE(*,*) ' MODE             : VECTOR (LENGTH=',VL_DIM,')'
+  ELSE
+     WRITE(*,*) ' MODE             : SCALAR'
+  ENDIF
+  !
+  WRITE(*,*) ' DE-INDEXING MODE :',I_LU_DI
+  !
+  WRITE(*,*) ' ICNTRL           : ',icntrl
+  WRITE(*,*) ' RCNTRL           : ',rcntrl
+  !
+  ! note: this is ONLY meaningful for vectorized (kp4)rosenbrock- methods
+  IF (l_vector)THEN
+     IF (l_fixed_step)THEN
+        WRITE(*,*) ' TIME STEPS       : FIXED (',t_steps(1:nfsteps),')'
+     ELSE
+        WRITE(*,*) ' TIME STEPS       : AUTOMATIC'
+     ENDIF
+  ELSE
+     WRITE(*,*) ' TIME STEPS       : AUTOMATIC '//&
+          &'(t_steps (CTRL_KPP) ignored in SCALAR MODE)'
+  ENDIF
+  ! mz_pj_20070531- 
+
+  status = 0
+
+
+END SUBROUTINE initialize_kpp_ctrl
+ 
+SUBROUTINE error_output(c, ierr, pe)
+
+
+  INTEGER, INTENT(IN):: ierr
+  INTEGER, INTENT(IN):: pe
+  REAL(dp), DIMENSION(:), INTENT(IN):: c
+
+  write(6,*) 'ERROR in chem_gasphase_mod ',ierr,C(1)
+
+
+END SUBROUTINE error_output
+ 
+      SUBROUTINE wscal(n, alpha, x, incx)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+!     constant times a vector: x(1:N) <- Alpha*x(1:N) 
+!     only for incX=incY=1
+!     after BLAS
+!     replace this by the function from the optimized BLAS implementation:
+!         CALL SSCAL(N,Alpha,X,1) or  CALL DSCAL(N,Alpha,X,1)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+
+      INTEGER  :: i, incx, m, mp1, n
+      REAL(kind=dp) :: x(n), alpha
+      REAL(kind=dp), PARAMETER  :: zero=0.0_dp, one=1.0_dp
+
+      IF (alpha .eq. one)RETURN
+      IF (n .le. 0)RETURN
+
+      m = mod(n, 5)
+      IF ( m .ne. 0)THEN
+        IF (alpha .eq. (- one))THEN
+          DO i = 1, m
+            x(i) = - x(i)
+          ENDDO
+        ELSEIF (alpha .eq. zero)THEN
+          DO i = 1, m
+            x(i) = zero
+          ENDDO
+        ELSE
+          DO i = 1, m
+            x(i) = alpha* x(i)
+          ENDDO
+        ENDIF
+        IF ( n .lt. 5)RETURN
+      ENDIF
+      mp1 = m + 1
+      IF (alpha .eq. (- one))THEN
+        DO i = mp1, n, 5
+          x(i)   = - x(i)
+          x(i + 1) = - x(i + 1)
+          x(i + 2) = - x(i + 2)
+          x(i + 3) = - x(i + 3)
+          x(i + 4) = - x(i + 4)
+        ENDDO
+      ELSEIF (alpha .eq. zero)THEN
+        DO i = mp1, n, 5
+          x(i)   = zero
+          x(i + 1) = zero
+          x(i + 2) = zero
+          x(i + 3) = zero
+          x(i + 4) = zero
+        ENDDO
+      ELSE
+        DO i = mp1, n, 5
+          x(i)   = alpha* x(i)
+          x(i + 1) = alpha* x(i + 1)
+          x(i + 2) = alpha* x(i + 2)
+          x(i + 3) = alpha* x(i + 3)
+          x(i + 4) = alpha* x(i + 4)
+        ENDDO
+      ENDIF
+
+      END SUBROUTINE wscal
+ 
+      SUBROUTINE waxpy(n, alpha, x, incx, y, incy)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+!     constant times a vector plus a vector: y <- y + Alpha*x
+!     only for incX=incY=1
+!     after BLAS
+!     replace this by the function from the optimized BLAS implementation:
+!         CALL SAXPY(N,Alpha,X,1,Y,1) or  CALL DAXPY(N,Alpha,X,1,Y,1)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+
+      INTEGER  :: i, incx, incy, m, mp1, n
+      REAL(kind=dp):: x(n), y(n), alpha
+      REAL(kind=dp), PARAMETER :: zero = 0.0_dp
+
+      IF (alpha .eq. zero)RETURN
+      IF (n .le. 0)RETURN
+
+      m = mod(n, 4)
+      IF ( m .ne. 0)THEN
+        DO i = 1, m
+          y(i) = y(i) + alpha* x(i)
+        ENDDO
+        IF ( n .lt. 4)RETURN
+      ENDIF
+      mp1 = m + 1
+      DO i = mp1, n, 4
+        y(i) = y(i) + alpha* x(i)
+        y(i + 1) = y(i + 1) + alpha* x(i + 1)
+        y(i + 2) = y(i + 2) + alpha* x(i + 2)
+        y(i + 3) = y(i + 3) + alpha* x(i + 3)
+      ENDDO
+      
+      END SUBROUTINE waxpy
+ 
+SUBROUTINE rosenbrock(n, y, tstart, tend, &
+           abstol, reltol,             &
+           rcntrl, icntrl, rstatus, istatus, ierr)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!    Solves the system y'=F(t,y) using a Rosenbrock method defined by:
+!
+!     G = 1/(H*gamma(1)) - Jac(t0,Y0)
+!     T_i = t0 + Alpha(i)*H
+!     Y_i = Y0 + \sum_{j=1}^{i-1} A(i,j)*K_j
+!     G *K_i = Fun( T_i,Y_i)+ \sum_{j=1}^S C(i,j)/H *K_j +
+!         gamma(i)*dF/dT(t0,Y0)
+!     Y1 = Y0 + \sum_{j=1}^S M(j)*K_j
+!
+!    For details on Rosenbrock methods and their implementation consult:
+!      E. Hairer and G. Wanner
+!      "Solving ODEs II. Stiff and differential-algebraic problems".
+!      Springer series in computational mathematics,Springer-Verlag,1996.
+!    The codes contained in the book inspired this implementation.
+!
+!    (C)  Adrian Sandu,August 2004
+!    Virginia Polytechnic Institute and State University
+!    Contact: sandu@cs.vt.edu
+!    Revised by Philipp Miehe and Adrian Sandu,May 2006                  
+!    This implementation is part of KPP - the Kinetic PreProcessor
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!~~~>   input arguments:
+!
+!-     y(n)  = vector of initial conditions (at t=tstart)
+!-    [tstart, tend]  = time range of integration
+!     (if Tstart>Tend the integration is performed backwards in time)
+!-    reltol, abstol = user precribed accuracy
+!- SUBROUTINE  fun( t, y, ydot) = ode FUNCTION, 
+!                       returns Ydot = Y' = F(T,Y)
+!- SUBROUTINE  jac( t, y, jcb) = jacobian of the ode FUNCTION, 
+!                       returns Jcb = dFun/dY
+!-    icntrl(1:20)  = INTEGER inputs PARAMETERs
+!-    rcntrl(1:20)  = REAL inputs PARAMETERs
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!~~~>     output arguments:
+!
+!-    y(n)  - > vector of final states (at t- >tend)
+!-    istatus(1:20) - > INTEGER output PARAMETERs
+!-    rstatus(1:20) - > REAL output PARAMETERs
+!-    ierr            - > job status upon RETURN
+!                        success (positive value) or
+!                        failure (negative value)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!~~~>     input PARAMETERs:
+!
+!    Note: For input parameters equal to zero the default values of the
+!       corresponding variables are used.
+!
+!    ICNTRL(1) = 1: F = F(y)   Independent of T (AUTONOMOUS)
+!              = 0: F = F(t,y) Depends on T (NON-AUTONOMOUS)
+!
+!    ICNTRL(2) = 0: AbsTol,RelTol are N-dimensional vectors
+!              = 1: AbsTol,RelTol are scalars
+!
+!    ICNTRL(3)  -> selection of a particular Rosenbrock method
+!        = 0 :    Rodas3 (default)
+!        = 1 :    Ros2
+!        = 2 :    Ros3
+!        = 3 :    Ros4
+!        = 4 :    Rodas3
+!        = 5 :    Rodas4
+!
+!    ICNTRL(4)  -> maximum number of integration steps
+!        For ICNTRL(4) =0) the default value of 100000 is used
+!
+!    RCNTRL(1)  -> Hmin,lower bound for the integration step size
+!          It is strongly recommended to keep Hmin = ZERO
+!    RCNTRL(2)  -> Hmax,upper bound for the integration step size
+!    RCNTRL(3)  -> Hstart,starting value for the integration step size
+!
+!    RCNTRL(4)  -> FacMin,lower bound on step decrease factor (default=0.2)
+!    RCNTRL(5)  -> FacMax,upper bound on step increase factor (default=6)
+!    RCNTRL(6)  -> FacRej,step decrease factor after multiple rejections
+!                          (default=0.1)
+!    RCNTRL(7)  -> FacSafe,by which the new step is slightly smaller
+!         than the predicted value  (default=0.9)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!
+!    OUTPUT ARGUMENTS:
+!    -----------------
+!
+!    T           -> T value for which the solution has been computed
+!                     (after successful return T=Tend).
+!
+!    Y(N)        -> Numerical solution at T
+!
+!    IDID        -> Reports on successfulness upon return:
+!                    = 1 for success
+!                    < 0 for error (value equals error code)
+!
+!    ISTATUS(1)  -> No. of function calls
+!    ISTATUS(2)  -> No. of jacobian calls
+!    ISTATUS(3)  -> No. of steps
+!    ISTATUS(4)  -> No. of accepted steps
+!    ISTATUS(5)  -> No. of rejected steps (except at very beginning)
+!    ISTATUS(6)  -> No. of LU decompositions
+!    ISTATUS(7)  -> No. of forward/backward substitutions
+!    ISTATUS(8)  -> No. of singular matrix decompositions
+!
+!    RSTATUS(1)  -> Texit,the time corresponding to the
+!                     computed Y upon return
+!    RSTATUS(2)  -> Hexit,last accepted step before exit
+!    RSTATUS(3)  -> Hnew,last predicted step (not yet taken)
+!                   For multiple restarts,use Hnew as Hstart 
+!                     in the subsequent run
+!
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~>  arguments
+   INTEGER,      INTENT(IN)  :: n
+   REAL(kind=dp), INTENT(INOUT):: y(n)
+   REAL(kind=dp), INTENT(IN)  :: tstart, tend
+   REAL(kind=dp), INTENT(IN)  :: abstol(n), reltol(n)
+   INTEGER,      INTENT(IN)  :: icntrl(20)
+   REAL(kind=dp), INTENT(IN)  :: rcntrl(20)
+   INTEGER,      INTENT(INOUT):: istatus(20)
+   REAL(kind=dp), INTENT(INOUT):: rstatus(20)
+   INTEGER, INTENT(OUT) :: ierr
+!~~~>  PARAMETERs of the rosenbrock method, up to 6 stages
+   INTEGER ::  ros_s, rosmethod
+   INTEGER, PARAMETER :: rs2=1, rs3=2, rs4=3, rd3=4, rd4=5, rg3=6
+   REAL(kind=dp):: ros_a(15), ros_c(15), ros_m(6), ros_e(6), &
+                    ros_alpha(6), ros_gamma(6), ros_elo
+   LOGICAL :: ros_newf(6)
+   CHARACTER(len=12):: ros_name
+!~~~>  local variables
+   REAL(kind=dp):: roundoff, facmin, facmax, facrej, facsafe
+   REAL(kind=dp):: hmin, hmax, hstart
+   REAL(kind=dp):: texit
+   INTEGER       :: i, uplimtol, max_no_steps
+   LOGICAL       :: autonomous, vectortol
+!~~~>   PARAMETERs
+   REAL(kind=dp), PARAMETER :: zero = 0.0_dp, one  = 1.0_dp
+   REAL(kind=dp), PARAMETER :: deltamin = 1.0e-5_dp
+
+!~~~>  initialize statistics
+   istatus(1:8) = 0
+   rstatus(1:3) = zero
+
+!~~~>  autonomous or time dependent ode. default is time dependent.
+   autonomous = .not.(icntrl(1) == 0)
+
+!~~~>  for scalar tolerances (icntrl(2).ne.0) the code uses abstol(1)and reltol(1)
+!   For Vector tolerances (ICNTRL(2) == 0) the code uses AbsTol(1:N) and RelTol(1:N)
+   IF (icntrl(2) == 0)THEN
+      vectortol = .TRUE.
+      uplimtol  = n
+   ELSE
+      vectortol = .FALSE.
+      uplimtol  = 1
+   ENDIF
+
+!~~~>   initialize the particular rosenbrock method selected
+   select CASE (icntrl(3))
+     CASE (1)
+       CALL ros2
+     CASE (2)
+       CALL ros3
+     CASE (3)
+       CALL ros4
+     CASE (0, 4)
+       CALL rodas3
+     CASE (5)
+       CALL rodas4
+     CASE (6)
+       CALL rang3
+     CASE default
+       PRINT *,'Unknown Rosenbrock method: ICNTRL(3) =',ICNTRL(3) 
+       CALL ros_errormsg(- 2, tstart, zero, ierr)
+       RETURN
+   END select
+
+!~~~>   the maximum number of steps admitted
+   IF (icntrl(4) == 0)THEN
+      max_no_steps = 200000
+   ELSEIF (icntrl(4)> 0)THEN
+      max_no_steps=icntrl(4)
+   ELSE
+      PRINT *,'User-selected max no. of steps: ICNTRL(4) =',ICNTRL(4)
+      CALL ros_errormsg(- 1, tstart, zero, ierr)
+      RETURN
+   ENDIF
+
+!~~~>  unit roundoff (1+ roundoff>1)
+   roundoff = epsilon(one)
+
+!~~~>  lower bound on the step size: (positive value)
+   IF (rcntrl(1) == zero)THEN
+      hmin = zero
+   ELSEIF (rcntrl(1)> zero)THEN
+      hmin = rcntrl(1)
+   ELSE
+      PRINT *,'User-selected Hmin: RCNTRL(1) =',RCNTRL(1)
+      CALL ros_errormsg(- 3, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  upper bound on the step size: (positive value)
+   IF (rcntrl(2) == zero)THEN
+      hmax = abs(tend-tstart)
+   ELSEIF (rcntrl(2)> zero)THEN
+      hmax = min(abs(rcntrl(2)), abs(tend-tstart))
+   ELSE
+      PRINT *,'User-selected Hmax: RCNTRL(2) =',RCNTRL(2)
+      CALL ros_errormsg(- 3, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  starting step size: (positive value)
+   IF (rcntrl(3) == zero)THEN
+      hstart = max(hmin, deltamin)
+   ELSEIF (rcntrl(3)> zero)THEN
+      hstart = min(abs(rcntrl(3)), abs(tend-tstart))
+   ELSE
+      PRINT *,'User-selected Hstart: RCNTRL(3) =',RCNTRL(3)
+      CALL ros_errormsg(- 3, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  step size can be changed s.t.  facmin < hnew/hold < facmax
+   IF (rcntrl(4) == zero)THEN
+      facmin = 0.2_dp
+   ELSEIF (rcntrl(4)> zero)THEN
+      facmin = rcntrl(4)
+   ELSE
+      PRINT *,'User-selected FacMin: RCNTRL(4) =',RCNTRL(4)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+   IF (rcntrl(5) == zero)THEN
+      facmax = 6.0_dp
+   ELSEIF (rcntrl(5)> zero)THEN
+      facmax = rcntrl(5)
+   ELSE
+      PRINT *,'User-selected FacMax: RCNTRL(5) =',RCNTRL(5)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>   facrej: factor to decrease step after 2 succesive rejections
+   IF (rcntrl(6) == zero)THEN
+      facrej = 0.1_dp
+   ELSEIF (rcntrl(6)> zero)THEN
+      facrej = rcntrl(6)
+   ELSE
+      PRINT *,'User-selected FacRej: RCNTRL(6) =',RCNTRL(6)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>   facsafe: safety factor in the computation of new step size
+   IF (rcntrl(7) == zero)THEN
+      facsafe = 0.9_dp
+   ELSEIF (rcntrl(7)> zero)THEN
+      facsafe = rcntrl(7)
+   ELSE
+      PRINT *,'User-selected FacSafe: RCNTRL(7) =',RCNTRL(7)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  check IF tolerances are reasonable
+    DO i=1, uplimtol
+      IF ((abstol(i)<= zero).or. (reltol(i)<= 10.0_dp* roundoff)&
+         .or. (reltol(i)>= 1.0_dp))THEN
+        PRINT *,' AbsTol(',i,') = ',AbsTol(i)
+        PRINT *,' RelTol(',i,') = ',RelTol(i)
+        CALL ros_errormsg(- 5, tstart, zero, ierr)
+        RETURN
+      ENDIF
+    ENDDO
+
+
+!~~~>  CALL rosenbrock method
+   CALL ros_integrator(y, tstart, tend, texit,  &
+        abstol, reltol,                         &
+!  Integration parameters
+        autonomous, vectortol, max_no_steps,    &
+        roundoff, hmin, hmax, hstart,           &
+        facmin, facmax, facrej, facsafe,        &
+!  Error indicator
+        ierr)
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+CONTAINS !  SUBROUTINEs internal to rosenbrock
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
+ SUBROUTINE ros_errormsg(code, t, h, ierr)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
+!    Handles all error messages
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
+  
+   REAL(kind=dp), INTENT(IN):: t, h
+   INTEGER, INTENT(IN) :: code
+   INTEGER, INTENT(OUT):: ierr
+   
+   ierr = code
+   print * , &
+     'Forced exit from Rosenbrock due to the following error:' 
+     
+   select CASE (code)
+    CASE (- 1)  
+      PRINT *,'--> Improper value for maximal no of steps'
+    CASE (- 2)  
+      PRINT *,'--> Selected Rosenbrock method not implemented'
+    CASE (- 3)  
+      PRINT *,'--> Hmin/Hmax/Hstart must be positive'
+    CASE (- 4)  
+      PRINT *,'--> FacMin/FacMax/FacRej must be positive'
+    CASE (- 5)
+      PRINT *,'--> Improper tolerance values'
+    CASE (- 6)
+      PRINT *,'--> No of steps exceeds maximum bound'
+    CASE (- 7)
+      PRINT *,'--> Step size too small: T + 10*H = T',&
+            ' or H < Roundoff'
+    CASE (- 8)  
+      PRINT *,'--> Matrix is repeatedly singular'
+    CASE default
+      PRINT *,'Unknown Error code: ',Code
+   END select
+   
+   print * , "t=", t, "and h=", h
+     
+ END SUBROUTINE ros_errormsg
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ SUBROUTINE ros_integrator (y, tstart, tend, t, &
+        abstol, reltol,                         &
+!~~~> integration PARAMETERs
+        autonomous, vectortol, max_no_steps,    &
+        roundoff, hmin, hmax, hstart,           &
+        facmin, facmax, facrej, facsafe,        &
+!~~~> error indicator
+        ierr)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!   Template for the implementation of a generic Rosenbrock method
+!      defined by ros_S (no of stages)
+!      and its coefficients ros_{A,C,M,E,Alpha,Gamma}
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~> input: the initial condition at tstart; output: the solution at t
+   REAL(kind=dp), INTENT(INOUT):: y(n)
+!~~~> input: integration interval
+   REAL(kind=dp), INTENT(IN):: tstart, tend
+!~~~> output: time at which the solution is RETURNed (t=tendIF success)
+   REAL(kind=dp), INTENT(OUT)::  t
+!~~~> input: tolerances
+   REAL(kind=dp), INTENT(IN)::  abstol(n), reltol(n)
+!~~~> input: integration PARAMETERs
+   LOGICAL, INTENT(IN):: autonomous, vectortol
+   REAL(kind=dp), INTENT(IN):: hstart, hmin, hmax
+   INTEGER, INTENT(IN):: max_no_steps
+   REAL(kind=dp), INTENT(IN):: roundoff, facmin, facmax, facrej, facsafe
+!~~~> output: error indicator
+   INTEGER, INTENT(OUT):: ierr
+! ~~~~ Local variables
+   REAL(kind=dp):: ynew(n), fcn0(n), fcn(n)
+   REAL(kind=dp):: k(n* ros_s), dfdt(n)
+#ifdef full_algebra    
+   REAL(kind=dp):: jac0(n, n), ghimj(n, n)
+#else
+   REAL(kind=dp):: jac0(lu_nonzero), ghimj(lu_nonzero)
+#endif
+   REAL(kind=dp):: h, hnew, hc, hg, fac, tau
+   REAL(kind=dp):: err, yerr(n)
+   INTEGER :: pivot(n), direction, ioffset, j, istage
+   LOGICAL :: rejectlasth, rejectmoreh, singular
+!~~~>  local PARAMETERs
+   REAL(kind=dp), PARAMETER :: zero = 0.0_dp, one  = 1.0_dp
+   REAL(kind=dp), PARAMETER :: deltamin = 1.0e-5_dp
+!~~~>  locally called FUNCTIONs
+!    REAL(kind=dp) WLAMCH
+!    EXTERNAL WLAMCH
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~>  initial preparations
+   t = tstart
+   rstatus(nhexit) = zero
+   h = min( max(abs(hmin), abs(hstart)), abs(hmax))
+   IF (abs(h)<= 10.0_dp* roundoff)h = deltamin
+
+   IF (tend  >=  tstart)THEN
+     direction = + 1
+   ELSE
+     direction = - 1
+   ENDIF
+   h = direction* h
+
+   rejectlasth=.FALSE.
+   rejectmoreh=.FALSE.
+
+!~~~> time loop begins below
+
+timeloop: DO WHILE((direction > 0).and.((t- tend) + roundoff <= zero)&
+       .or. (direction < 0).and.((tend-t) + roundoff <= zero))
+
+   IF (istatus(nstp)> max_no_steps)THEN  ! too many steps
+      CALL ros_errormsg(- 6, t, h, ierr)
+      RETURN
+   ENDIF
+   IF (((t+ 0.1_dp* h) == t).or.(h <= roundoff))THEN  ! step size too small
+      CALL ros_errormsg(- 7, t, h, ierr)
+      RETURN
+   ENDIF
+
+!~~~>  limit h IF necessary to avoid going beyond tend
+   h = min(h, abs(tend-t))
+
+!~~~>   compute the FUNCTION at current time
+   CALL funtemplate(t, y, fcn0)
+   istatus(nfun) = istatus(nfun) + 1
+
+!~~~>  compute the FUNCTION derivative with respect to t
+   IF (.not.autonomous)THEN
+      CALL ros_funtimederivative(t, roundoff, y, &
+                fcn0, dfdt)
+   ENDIF
+
+!~~~>   compute the jacobian at current time
+   CALL jactemplate(t, y, jac0)
+   istatus(njac) = istatus(njac) + 1
+
+!~~~>  repeat step calculation until current step accepted
+untilaccepted: do
+
+   CALL ros_preparematrix(h, direction, ros_gamma(1), &
+          jac0, ghimj, pivot, singular)
+   IF (singular)THEN ! more than 5 consecutive failed decompositions
+       CALL ros_errormsg(- 8, t, h, ierr)
+       RETURN
+   ENDIF
+
+!~~~>   compute the stages
+stage: DO istage = 1, ros_s
+
+      ! current istage offset. current istage vector is k(ioffset+ 1:ioffset+ n)
+       ioffset = n* (istage-1)
+
+      ! for the 1st istage the FUNCTION has been computed previously
+       IF (istage == 1)THEN
+         !slim: CALL wcopy(n, fcn0, 1, fcn, 1)
+       fcn(1:n) = fcn0(1:n)
+      ! istage>1 and a new FUNCTION evaluation is needed at the current istage
+       ELSEIF(ros_newf(istage))THEN
+         !slim: CALL wcopy(n, y, 1, ynew, 1)
+       ynew(1:n) = y(1:n)
+         DO j = 1, istage-1
+           CALL waxpy(n, ros_a((istage-1) * (istage-2) /2+ j), &
+            k(n* (j- 1) + 1), 1, ynew, 1)
+         ENDDO
+         tau = t + ros_alpha(istage) * direction* h
+         CALL funtemplate(tau, ynew, fcn)
+         istatus(nfun) = istatus(nfun) + 1
+       ENDIF ! IF istage == 1 ELSEIF ros_newf(istage)
+       !slim: CALL wcopy(n, fcn, 1, k(ioffset+ 1), 1)
+       k(ioffset+ 1:ioffset+ n) = fcn(1:n)
+       DO j = 1, istage-1
+         hc = ros_c((istage-1) * (istage-2) /2+ j) /(direction* h)
+         CALL waxpy(n, hc, k(n* (j- 1) + 1), 1, k(ioffset+ 1), 1)
+       ENDDO
+       IF ((.not. autonomous).and.(ros_gamma(istage).ne.zero))THEN
+         hg = direction* h* ros_gamma(istage)
+         CALL waxpy(n, hg, dfdt, 1, k(ioffset+ 1), 1)
+       ENDIF
+       CALL ros_solve(ghimj, pivot, k(ioffset+ 1))
+
+   END DO stage
+
+
+!~~~>  compute the new solution
+   !slim: CALL wcopy(n, y, 1, ynew, 1)
+   ynew(1:n) = y(1:n)
+   DO j=1, ros_s
+         CALL waxpy(n, ros_m(j), k(n* (j- 1) + 1), 1, ynew, 1)
+   ENDDO
+
+!~~~>  compute the error estimation
+   !slim: CALL wscal(n, zero, yerr, 1)
+   yerr(1:n) = zero
+   DO j=1, ros_s
+        CALL waxpy(n, ros_e(j), k(n* (j- 1) + 1), 1, yerr, 1)
+   ENDDO
+   err = ros_errornorm(y, ynew, yerr, abstol, reltol, vectortol)
+
+!~~~> new step size is bounded by facmin <= hnew/h <= facmax
+   fac  = min(facmax, max(facmin, facsafe/err** (one/ros_elo)))
+   hnew = h* fac
+
+!~~~>  check the error magnitude and adjust step size
+   istatus(nstp) = istatus(nstp) + 1
+   IF ((err <= one).or.(h <= hmin))THEN  !~~~> accept step
+      istatus(nacc) = istatus(nacc) + 1
+      !slim: CALL wcopy(n, ynew, 1, y, 1)
+      y(1:n) = ynew(1:n)
+      t = t + direction* h
+      hnew = max(hmin, min(hnew, hmax))
+      IF (rejectlasth)THEN  ! no step size increase after a rejected step
+         hnew = min(hnew, h)
+      ENDIF
+      rstatus(nhexit) = h
+      rstatus(nhnew) = hnew
+      rstatus(ntexit) = t
+      rejectlasth = .FALSE.
+      rejectmoreh = .FALSE.
+      h = hnew
+      exit untilaccepted ! exit the loop: WHILE step not accepted
+   ELSE           !~~~> reject step
+      IF (rejectmoreh)THEN
+         hnew = h* facrej
+      ENDIF
+      rejectmoreh = rejectlasth
+      rejectlasth = .TRUE.
+      h = hnew
+      IF (istatus(nacc)>= 1) istatus(nrej) = istatus(nrej) + 1
+   ENDIF ! err <= 1
+
+   END DO untilaccepted
+
+   END DO timeloop
+
+!~~~> succesful exit
+   ierr = 1  !~~~> the integration was successful
+
+  END SUBROUTINE ros_integrator
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  REAL(kind=dp)FUNCTION ros_errornorm(y, ynew, yerr, &
+                               abstol, reltol, vectortol)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> computes the "scaled norm" of the error vector yerr
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+! Input arguments
+   REAL(kind=dp), INTENT(IN):: y(n), ynew(n), &
+          yerr(n), abstol(n), reltol(n)
+   LOGICAL, INTENT(IN)::  vectortol
+! Local variables
+   REAL(kind=dp):: err, scale, ymax
+   INTEGER  :: i
+   REAL(kind=dp), PARAMETER :: zero = 0.0_dp
+
+   err = zero
+   DO i=1, n
+     ymax = max(abs(y(i)), abs(ynew(i)))
+     IF (vectortol)THEN
+       scale = abstol(i) + reltol(i) * ymax
+     ELSE
+       scale = abstol(1) + reltol(1) * ymax
+     ENDIF
+     err = err+ (yerr(i) /scale) ** 2
+   ENDDO
+   err  = sqrt(err/n)
+
+   ros_errornorm = max(err, 1.0d-10)
+
+  END FUNCTION ros_errornorm
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_funtimederivative(t, roundoff, y, &
+                fcn0, dfdt)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> the time partial derivative of the FUNCTION by finite differences
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+!~~~> input arguments
+   REAL(kind=dp), INTENT(IN):: t, roundoff, y(n), fcn0(n)
+!~~~> output arguments
+   REAL(kind=dp), INTENT(OUT):: dfdt(n)
+!~~~> local variables
+   REAL(kind=dp):: delta
+   REAL(kind=dp), PARAMETER :: one = 1.0_dp, deltamin = 1.0e-6_dp
+
+   delta = sqrt(roundoff) * max(deltamin, abs(t))
+   CALL funtemplate(t+ delta, y, dfdt)
+   istatus(nfun) = istatus(nfun) + 1
+   CALL waxpy(n, (- one), fcn0, 1, dfdt, 1)
+   CALL wscal(n, (one/delta), dfdt, 1)
+
+  END SUBROUTINE ros_funtimederivative
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_preparematrix(h, direction, gam, &
+             jac0, ghimj, pivot, singular)
+! --- --- --- --- --- --- --- --- --- --- --- --- ---
+!  Prepares the LHS matrix for stage calculations
+!  1.  Construct Ghimj = 1/(H*ham) - Jac0
+!      "(Gamma H) Inverse Minus Jacobian"
+!  2.  Repeat LU decomposition of Ghimj until successful.
+!       -half the step size if LU decomposition fails and retry
+!       -exit after 5 consecutive fails
+! --- --- --- --- --- --- --- --- --- --- --- --- ---
+
+!~~~> input arguments
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(IN)::  jac0(n, n)
+#else
+   REAL(kind=dp), INTENT(IN)::  jac0(lu_nonzero)
+#endif   
+   REAL(kind=dp), INTENT(IN)::  gam
+   INTEGER, INTENT(IN)::  direction
+!~~~> output arguments
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(OUT):: ghimj(n, n)
+#else
+   REAL(kind=dp), INTENT(OUT):: ghimj(lu_nonzero)
+#endif   
+   LOGICAL, INTENT(OUT)::  singular
+   INTEGER, INTENT(OUT)::  pivot(n)
+!~~~> inout arguments
+   REAL(kind=dp), INTENT(INOUT):: h   ! step size is decreased when lu fails
+!~~~> local variables
+   INTEGER  :: i, ising, nconsecutive
+   REAL(kind=dp):: ghinv
+   REAL(kind=dp), PARAMETER :: one  = 1.0_dp, half = 0.5_dp
+
+   nconsecutive = 0
+   singular = .TRUE.
+
+   DO WHILE (singular)
+
+!~~~>    construct ghimj = 1/(h* gam) - jac0
+#ifdef full_algebra    
+     !slim: CALL wcopy(n* n, jac0, 1, ghimj, 1)
+     !slim: CALL wscal(n* n, (- one), ghimj, 1)
+     ghimj = - jac0
+     ghinv = one/(direction* h* gam)
+     DO i=1, n
+       ghimj(i, i) = ghimj(i, i) + ghinv
+     ENDDO
+#else
+     !slim: CALL wcopy(lu_nonzero, jac0, 1, ghimj, 1)
+     !slim: CALL wscal(lu_nonzero, (- one), ghimj, 1)
+     ghimj(1:lu_nonzero) = - jac0(1:lu_nonzero)
+     ghinv = one/(direction* h* gam)
+     DO i=1, n
+       ghimj(lu_diag(i)) = ghimj(lu_diag(i)) + ghinv
+     ENDDO
+#endif   
+!~~~>    compute lu decomposition
+     CALL ros_decomp( ghimj, pivot, ising)
+     IF (ising == 0)THEN
+!~~~>    IF successful done
+        singular = .FALSE.
+     ELSE ! ising .ne. 0
+!~~~>    IF unsuccessful half the step size; IF 5 consecutive fails THEN RETURN
+        istatus(nsng) = istatus(nsng) + 1
+        nconsecutive = nconsecutive+1
+        singular = .TRUE.
+        PRINT*,'Warning: LU Decomposition returned ISING = ',ISING
+        IF (nconsecutive <= 5)THEN ! less than 5 consecutive failed decompositions
+           h = h* half
+        ELSE  ! more than 5 consecutive failed decompositions
+           RETURN
+        ENDIF  ! nconsecutive
+      ENDIF    ! ising
+
+   END DO ! WHILE singular
+
+  END SUBROUTINE ros_preparematrix
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_decomp( a, pivot, ising)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the LU decomposition
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> inout variables
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(INOUT):: a(n, n)
+#else   
+   REAL(kind=dp), INTENT(INOUT):: a(lu_nonzero)
+#endif
+!~~~> output variables
+   INTEGER, INTENT(OUT):: pivot(n), ising
+
+#ifdef full_algebra    
+   CALL  dgetrf( n, n, a, n, pivot, ising)
+#else   
+   CALL kppdecomp(a, ising)
+   pivot(1) = 1
+#endif
+   istatus(ndec) = istatus(ndec) + 1
+
+  END SUBROUTINE ros_decomp
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_solve( a, pivot, b)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the forward/backward substitution (using pre-computed LU decomposition)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> input variables
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(IN):: a(n, n)
+   INTEGER :: ising
+#else   
+   REAL(kind=dp), INTENT(IN):: a(lu_nonzero)
+#endif
+   INTEGER, INTENT(IN):: pivot(n)
+!~~~> inout variables
+   REAL(kind=dp), INTENT(INOUT):: b(n)
+
+#ifdef full_algebra    
+   CALL  DGETRS( 'N',N ,1,A,N,Pivot,b,N,ISING)
+   IF (info < 0)THEN
+      print* , "error in dgetrs. ising=", ising
+   ENDIF  
+#else   
+   CALL kppsolve( a, b)
+#endif
+
+   istatus(nsol) = istatus(nsol) + 1
+
+  END SUBROUTINE ros_solve
+
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros2
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! --- AN L-STABLE METHOD,2 stages,order 2
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+   double precision g
+
+    g = 1.0_dp + 1.0_dp/sqrt(2.0_dp)
+    rosmethod = rs2
+!~~~> name of the method
+    ros_Name = 'ROS-2'
+!~~~> number of stages
+    ros_s = 2
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+    ros_a(1) = (1.0_dp) /g
+    ros_c(1) = (- 2.0_dp) /g
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+    ros_newf(1) = .TRUE.
+    ros_newf(2) = .TRUE.
+!~~~> m_i = coefficients for new step solution
+    ros_m(1) = (3.0_dp) /(2.0_dp* g)
+    ros_m(2) = (1.0_dp) /(2.0_dp* g)
+! E_i = Coefficients for error estimator
+    ros_e(1) = 1.0_dp/(2.0_dp* g)
+    ros_e(2) = 1.0_dp/(2.0_dp* g)
+!~~~> ros_elo = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus one
+    ros_elo = 2.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+    ros_alpha(1) = 0.0_dp
+    ros_alpha(2) = 1.0_dp
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+    ros_gamma(1) = g
+    ros_gamma(2) = -g
+
+ END SUBROUTINE ros2
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! --- AN L-STABLE METHOD,3 stages,order 3,2 function evaluations
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+   rosmethod = rs3
+!~~~> name of the method
+   ros_Name = 'ROS-3'
+!~~~> number of stages
+   ros_s = 3
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+   ros_a(1) = 1.0_dp
+   ros_a(2) = 1.0_dp
+   ros_a(3) = 0.0_dp
+
+   ros_c(1) = - 0.10156171083877702091975600115545e+01_dp
+   ros_c(2) =  0.40759956452537699824805835358067e+01_dp
+   ros_c(3) =  0.92076794298330791242156818474003e+01_dp
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+   ros_newf(1) = .TRUE.
+   ros_newf(2) = .TRUE.
+   ros_newf(3) = .FALSE.
+!~~~> m_i = coefficients for new step solution
+   ros_m(1) =  0.1e+01_dp
+   ros_m(2) =  0.61697947043828245592553615689730e+01_dp
+   ros_m(3) = - 0.42772256543218573326238373806514_dp
+! E_i = Coefficients for error estimator
+   ros_e(1) =  0.5_dp
+   ros_e(2) = - 0.29079558716805469821718236208017e+01_dp
+   ros_e(3) =  0.22354069897811569627360909276199_dp
+!~~~> ros_elo = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus 1
+   ros_elo = 3.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+   ros_alpha(1) = 0.0_dp
+   ros_alpha(2) = 0.43586652150845899941601945119356_dp
+   ros_alpha(3) = 0.43586652150845899941601945119356_dp
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+   ros_gamma(1) = 0.43586652150845899941601945119356_dp
+   ros_gamma(2) = 0.24291996454816804366592249683314_dp
+   ros_gamma(3) = 0.21851380027664058511513169485832e+01_dp
+
+  END SUBROUTINE ros3
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros4
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     L-STABLE ROSENBROCK METHOD OF ORDER 4,WITH 4 STAGES
+!     L-STABLE EMBEDDED ROSENBROCK METHOD OF ORDER 3
+!
+!      E. HAIRER AND G. WANNER,SOLVING ORDINARY DIFFERENTIAL
+!      EQUATIONS II. STIFF AND DIFFERENTIAL-ALGEBRAIC PROBLEMS.
+!      SPRINGER SERIES IN COMPUTATIONAL MATHEMATICS,
+!      SPRINGER-VERLAG (1990)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+   rosmethod = rs4
+!~~~> name of the method
+   ros_Name = 'ROS-4'
+!~~~> number of stages
+   ros_s = 4
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+   ros_a(1) = 0.2000000000000000e+01_dp
+   ros_a(2) = 0.1867943637803922e+01_dp
+   ros_a(3) = 0.2344449711399156_dp
+   ros_a(4) = ros_a(2)
+   ros_a(5) = ros_a(3)
+   ros_a(6) = 0.0_dp
+
+   ros_c(1) = -0.7137615036412310e+01_dp
+   ros_c(2) = 0.2580708087951457e+01_dp
+   ros_c(3) = 0.6515950076447975_dp
+   ros_c(4) = -0.2137148994382534e+01_dp
+   ros_c(5) = -0.3214669691237626_dp
+   ros_c(6) = -0.6949742501781779_dp
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+   ros_newf(1) = .TRUE.
+   ros_newf(2) = .TRUE.
+   ros_newf(3) = .TRUE.
+   ros_newf(4) = .FALSE.
+!~~~> m_i = coefficients for new step solution
+   ros_m(1) = 0.2255570073418735e+01_dp
+   ros_m(2) = 0.2870493262186792_dp
+   ros_m(3) = 0.4353179431840180_dp
+   ros_m(4) = 0.1093502252409163e+01_dp
+!~~~> e_i  = coefficients for error estimator
+   ros_e(1) = -0.2815431932141155_dp
+   ros_e(2) = -0.7276199124938920e-01_dp
+   ros_e(3) = -0.1082196201495311_dp
+   ros_e(4) = -0.1093502252409163e+01_dp
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus 1
+   ros_elo  = 4.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+   ros_alpha(1) = 0.0_dp
+   ros_alpha(2) = 0.1145640000000000e+01_dp
+   ros_alpha(3) = 0.6552168638155900_dp
+   ros_alpha(4) = ros_alpha(3)
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+   ros_gamma(1) = 0.5728200000000000_dp
+   ros_gamma(2) = -0.1769193891319233e+01_dp
+   ros_gamma(3) = 0.7592633437920482_dp
+   ros_gamma(4) = -0.1049021087100450_dp
+
+  END SUBROUTINE ros4
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE rodas3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! --- A STIFFLY-STABLE METHOD,4 stages,order 3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+   rosmethod = rd3
+!~~~> name of the method
+   ros_Name = 'RODAS-3'
+!~~~> number of stages
+   ros_s = 4
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+   ros_a(1) = 0.0_dp
+   ros_a(2) = 2.0_dp
+   ros_a(3) = 0.0_dp
+   ros_a(4) = 2.0_dp
+   ros_a(5) = 0.0_dp
+   ros_a(6) = 1.0_dp
+
+   ros_c(1) = 4.0_dp
+   ros_c(2) = 1.0_dp
+   ros_c(3) = -1.0_dp
+   ros_c(4) = 1.0_dp
+   ros_c(5) = -1.0_dp
+   ros_c(6) = -(8.0_dp/3.0_dp)
+
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+   ros_newf(1) = .TRUE.
+   ros_newf(2) = .FALSE.
+   ros_newf(3) = .TRUE.
+   ros_newf(4) = .TRUE.
+!~~~> m_i = coefficients for new step solution
+   ros_m(1) = 2.0_dp
+   ros_m(2) = 0.0_dp
+   ros_m(3) = 1.0_dp
+   ros_m(4) = 1.0_dp
+!~~~> e_i  = coefficients for error estimator
+   ros_e(1) = 0.0_dp
+   ros_e(2) = 0.0_dp
+   ros_e(3) = 0.0_dp
+   ros_e(4) = 1.0_dp
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus 1
+   ros_elo  = 3.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+   ros_alpha(1) = 0.0_dp
+   ros_alpha(2) = 0.0_dp
+   ros_alpha(3) = 1.0_dp
+   ros_alpha(4) = 1.0_dp
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+   ros_gamma(1) = 0.5_dp
+   ros_gamma(2) = 1.5_dp
+   ros_gamma(3) = 0.0_dp
+   ros_gamma(4) = 0.0_dp
+
+  END SUBROUTINE rodas3
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE rodas4
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     STIFFLY-STABLE ROSENBROCK METHOD OF ORDER 4,WITH 6 STAGES
+!
+!      E. HAIRER AND G. WANNER,SOLVING ORDINARY DIFFERENTIAL
+!      EQUATIONS II. STIFF AND DIFFERENTIAL-ALGEBRAIC PROBLEMS.
+!      SPRINGER SERIES IN COMPUTATIONAL MATHEMATICS,
+!      SPRINGER-VERLAG (1996)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+    rosmethod = rd4
+!~~~> name of the method
+    ros_Name = 'RODAS-4'
+!~~~> number of stages
+    ros_s = 6
+
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+    ros_alpha(1) = 0.000_dp
+    ros_alpha(2) = 0.386_dp
+    ros_alpha(3) = 0.210_dp
+    ros_alpha(4) = 0.630_dp
+    ros_alpha(5) = 1.000_dp
+    ros_alpha(6) = 1.000_dp
+
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+    ros_gamma(1) = 0.2500000000000000_dp
+    ros_gamma(2) = -0.1043000000000000_dp
+    ros_gamma(3) = 0.1035000000000000_dp
+    ros_gamma(4) = -0.3620000000000023e-01_dp
+    ros_gamma(5) = 0.0_dp
+    ros_gamma(6) = 0.0_dp
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:  A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!                  C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+    ros_a(1) = 0.1544000000000000e+01_dp
+    ros_a(2) = 0.9466785280815826_dp
+    ros_a(3) = 0.2557011698983284_dp
+    ros_a(4) = 0.3314825187068521e+01_dp
+    ros_a(5) = 0.2896124015972201e+01_dp
+    ros_a(6) = 0.9986419139977817_dp
+    ros_a(7) = 0.1221224509226641e+01_dp
+    ros_a(8) = 0.6019134481288629e+01_dp
+    ros_a(9) = 0.1253708332932087e+02_dp
+    ros_a(10) = -0.6878860361058950_dp
+    ros_a(11) = ros_a(7)
+    ros_a(12) = ros_a(8)
+    ros_a(13) = ros_a(9)
+    ros_a(14) = ros_a(10)
+    ros_a(15) = 1.0_dp
+
+    ros_c(1) = -0.5668800000000000e+01_dp
+    ros_c(2) = -0.2430093356833875e+01_dp
+    ros_c(3) = -0.2063599157091915_dp
+    ros_c(4) = -0.1073529058151375_dp
+    ros_c(5) = -0.9594562251023355e+01_dp
+    ros_c(6) = -0.2047028614809616e+02_dp
+    ros_c(7) = 0.7496443313967647e+01_dp
+    ros_c(8) = -0.1024680431464352e+02_dp
+    ros_c(9) = -0.3399990352819905e+02_dp
+    ros_c(10) = 0.1170890893206160e+02_dp
+    ros_c(11) = 0.8083246795921522e+01_dp
+    ros_c(12) = -0.7981132988064893e+01_dp
+    ros_c(13) = -0.3152159432874371e+02_dp
+    ros_c(14) = 0.1631930543123136e+02_dp
+    ros_c(15) = -0.6058818238834054e+01_dp
+
+!~~~> m_i = coefficients for new step solution
+    ros_m(1) = ros_a(7)
+    ros_m(2) = ros_a(8)
+    ros_m(3) = ros_a(9)
+    ros_m(4) = ros_a(10)
+    ros_m(5) = 1.0_dp
+    ros_m(6) = 1.0_dp
+
+!~~~> e_i  = coefficients for error estimator
+    ros_e(1) = 0.0_dp
+    ros_e(2) = 0.0_dp
+    ros_e(3) = 0.0_dp
+    ros_e(4) = 0.0_dp
+    ros_e(5) = 0.0_dp
+    ros_e(6) = 1.0_dp
+
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+    ros_newf(1) = .TRUE.
+    ros_newf(2) = .TRUE.
+    ros_newf(3) = .TRUE.
+    ros_newf(4) = .TRUE.
+    ros_newf(5) = .TRUE.
+    ros_newf(6) = .TRUE.
+
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!        main and the embedded scheme orders plus 1
+    ros_elo = 4.0_dp
+
+  END SUBROUTINE rodas4
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE rang3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! STIFFLY-STABLE W METHOD OF ORDER 3,WITH 4 STAGES
+!
+! J. RANG and L. ANGERMANN
+! NEW ROSENBROCK W-METHODS OF ORDER 3
+! FOR PARTIAL DIFFERENTIAL ALGEBRAIC
+!        EQUATIONS OF INDEX 1                                             
+! BIT Numerical Mathematics (2005) 45: 761-787
+!  DOI: 10.1007/s10543-005-0035-y
+! Table 4.1-4.2
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+    rosmethod = rg3
+!~~~> name of the method
+    ros_Name = 'RANG-3'
+!~~~> number of stages
+    ros_s = 4
+
+    ros_a(1) = 5.09052051067020d+00;
+    ros_a(2) = 5.09052051067020d+00;
+    ros_a(3) = 0.0d0;
+    ros_a(4) = 4.97628111010787d+00;
+    ros_a(5) = 2.77268164715849d-02;
+    ros_a(6) = 2.29428036027904d-01;
+
+    ros_c(1) = - 1.16790812312283d+01;
+    ros_c(2) = - 1.64057326467367d+01;
+    ros_c(3) = - 2.77268164715850d-01;
+    ros_c(4) = - 8.38103960500476d+00;
+    ros_c(5) = - 8.48328409199343d-01;
+    ros_c(6) =  2.87009860433106d-01;
+
+    ros_m(1) =  5.22582761233094d+00;
+    ros_m(2) = - 5.56971148154165d-01;
+    ros_m(3) =  3.57979469353645d-01;
+    ros_m(4) =  1.72337398521064d+00;
+
+    ros_e(1) = - 5.16845212784040d+00;
+    ros_e(2) = - 1.26351942603842d+00;
+    ros_e(3) = - 1.11022302462516d-16;
+    ros_e(4) =  2.22044604925031d-16;
+
+    ros_alpha(1) = 0.0d00;
+    ros_alpha(2) = 2.21878746765329d+00;
+    ros_alpha(3) = 2.21878746765329d+00;
+    ros_alpha(4) = 1.55392337535788d+00;
+
+    ros_gamma(1) =  4.35866521508459d-01;
+    ros_gamma(2) = - 1.78292094614483d+00;
+    ros_gamma(3) = - 2.46541900496934d+00;
+    ros_gamma(4) = - 8.05529997906370d-01;
+
+
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+    ros_newf(1) = .TRUE.
+    ros_newf(2) = .TRUE.
+    ros_newf(3) = .TRUE.
+    ros_newf(4) = .TRUE.
+
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!        main and the embedded scheme orders plus 1
+    ros_elo = 3.0_dp
+
+  END SUBROUTINE rang3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!   End of the set of internal Rosenbrock subroutines
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END SUBROUTINE rosenbrock
+ 
+SUBROUTINE funtemplate( t, y, ydot)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the ODE function call.
+!  Updates the rate coefficients (and possibly the fixed species) at each call
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> input variables
+   REAL(kind=dp):: t, y(nvar)
+!~~~> output variables
+   REAL(kind=dp):: ydot(nvar)
+!~~~> local variables
+   REAL(kind=dp):: told
+
+   told = time
+   time = t
+   CALL fun( y, fix, rconst, ydot)
+   time = told
+
+END SUBROUTINE funtemplate
+ 
+SUBROUTINE jactemplate( t, y, jcb)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the ODE Jacobian call.
+!  Updates the rate coefficients (and possibly the fixed species) at each call
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> input variables
+    REAL(kind=dp):: t, y(nvar)
+!~~~> output variables
+#ifdef full_algebra    
+    REAL(kind=dp):: jv(lu_nonzero), jcb(nvar, nvar)
+#else
+    REAL(kind=dp):: jcb(lu_nonzero)
+#endif   
+!~~~> local variables
+    REAL(kind=dp):: told
+#ifdef full_algebra    
+    INTEGER :: i, j
+#endif   
+
+    told = time
+    time = t
+#ifdef full_algebra    
+    CALL jac_sp(y, fix, rconst, jv)
+    DO j=1, nvar
+      DO i=1, nvar
+         jcb(i, j) = 0.0_dp
+      ENDDO
+    ENDDO
+    DO i=1, lu_nonzero
+       jcb(lu_irow(i), lu_icol(i)) = jv(i)
+    ENDDO
+#else
+    CALL jac_sp( y, fix, rconst, jcb)
+#endif   
+    time = told
+
+END SUBROUTINE jactemplate
+ 
+  SUBROUTINE kppdecomp( jvs, ier)                                    
+  ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
+  !        sparse lu factorization                                    
+  ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
+  ! loop expansion generated by kp4                                   
+                                                                      
+    INTEGER  :: ier                                                   
+    REAL(kind=dp):: jvs(lu_nonzero), w(nvar), a             
+    INTEGER  :: k, kk, j, jj                                          
+                                                                      
+    a = 0.                                                            
+    ier = 0                                                           
+                                                                      
+!   i = 1
+!   i = 2
+!   i = 3
+!   i = 4
+!   i = 5
+    jvs(12) = (jvs(12)) / jvs(7) 
+    jvs(14) = jvs(14) - jvs(8) * jvs(12)
+!   i = 6
+    jvs(16) = (jvs(16)) / jvs(7) 
+    jvs(17) = (jvs(17)) / jvs(9) 
+    a = 0.0; a = a  - jvs(10) * jvs(17)
+    jvs(18) = (jvs(18) + a) / jvs(13) 
+    jvs(19) = jvs(19) - jvs(8) * jvs(16) - jvs(14) * jvs(18)
+    jvs(22) = jvs(22) - jvs(11) * jvs(17) - jvs(15) * jvs(18)
+!   i = 7
+    jvs(23) = (jvs(23)) / jvs(9) 
+    a = 0.0; a = a  - jvs(10) * jvs(23)
+    jvs(24) = (jvs(24) + a) / jvs(13) 
+    a = 0.0; a = a  - jvs(14) * jvs(24)
+    jvs(25) = (jvs(25) + a) / jvs(19) 
+    jvs(26) = jvs(26) - jvs(20) * jvs(25)
+    jvs(27) = jvs(27) - jvs(21) * jvs(25)
+    jvs(28) = jvs(28) - jvs(11) * jvs(23) - jvs(15) * jvs(24) - jvs(22) * jvs(25)
+!   i = 8
+    jvs(29) = (jvs(29)) / jvs(26) 
+    jvs(30) = jvs(30) - jvs(27) * jvs(29)
+    jvs(31) = jvs(31) - jvs(28) * jvs(29)
+!   i = 9
+    jvs(32) = (jvs(32)) / jvs(9) 
+    a = 0.0; a = a  - jvs(10) * jvs(32)
+    jvs(33) = (jvs(33) + a) / jvs(13) 
+    a = 0.0; a = a  - jvs(14) * jvs(33)
+    jvs(34) = (jvs(34) + a) / jvs(19) 
+    a = 0.0; a = a  - jvs(20) * jvs(34)
+    jvs(35) = (jvs(35) + a) / jvs(26) 
+    a = 0.0; a = a  - jvs(21) * jvs(34) - jvs(27) * jvs(35)
+    jvs(36) = (jvs(36) + a) / jvs(30) 
+    jvs(37) = jvs(37) - jvs(11) * jvs(32) - jvs(15) * jvs(33) - jvs(22) * jvs(34) - jvs(28) * jvs(35)&
+          - jvs(31) * jvs(36)
+    RETURN                                                            
+                                                                      
+  END SUBROUTINE kppdecomp                                            
+ 
+SUBROUTINE chem_gasphase_integrate (time_step_len, conc, tempi, qvapi, fakti, photo, ierrf, xnacc, xnrej, istatus, l_debug, pe, &
+                     icntrl_i, rcntrl_i) 
+                                                                    
+  IMPLICIT NONE                                                     
+                                                                    
+  REAL(dp), INTENT(IN)                  :: time_step_len           
+  REAL(dp), DIMENSION(:, :), INTENT(INOUT) :: conc                    
+  REAL(dp), DIMENSION(:, :), INTENT(IN)   :: photo                   
+  REAL(dp), DIMENSION(:), INTENT(IN)     :: tempi                   
+  REAL(dp), DIMENSION(:), INTENT(IN)     :: qvapi                   
+  REAL(dp), DIMENSION(:), INTENT(IN)     :: fakti                   
+  INTEGER, INTENT(OUT), OPTIONAL        :: ierrf(:)               
+  INTEGER, INTENT(OUT), OPTIONAL        :: xnacc(:)               
+  INTEGER, INTENT(OUT), OPTIONAL        :: xnrej(:)               
+  INTEGER, INTENT(INOUT), OPTIONAL      :: istatus(:)             
+  INTEGER, INTENT(IN), OPTIONAL         :: pe                      
+  LOGICAL, INTENT(IN), OPTIONAL         :: l_debug                 
+  INTEGER, DIMENSION(nkppctrl), INTENT(IN), OPTIONAL  :: icntrl_i         
+  REAL(dp), DIMENSION(nkppctrl), INTENT(IN), OPTIONAL  :: rcntrl_i         
+                                                                    
+  INTEGER                                 :: k   ! loop variable     
+  REAL(dp)                               :: dt                      
+  INTEGER, DIMENSION(20)                :: istatus_u               
+  INTEGER                                :: ierr_u                  
+  INTEGER                                :: istatf                  
+  INTEGER                                :: vl_dim_lo               
+                                                                    
+                                                                    
+  IF (PRESENT (istatus)) istatus = 0                             
+  IF (PRESENT (icntrl_i)) icntrl  = icntrl_i                      
+  IF (PRESENT (rcntrl_i)) rcntrl  = rcntrl_i                      
+                                                                    
+  vl_glo = size(tempi, 1)                                           
+                                                                    
+  vl_dim_lo = vl_dim                                                
+  DO k=1, vl_glo, vl_dim_lo                                           
+    is = k                                                          
+    ie = min(k+ vl_dim_lo-1, vl_glo)                                 
+    vl = ie-is+ 1                                                    
+                                                                    
+    c(:) = conc(is, :)                                            
+                                                                    
+    temp = tempi(is)                                             
+                                                                    
+    qvap = qvapi(is)                                             
+                                                                    
+    fakt = fakti(is)                                             
+                                                                    
+    CALL initialize                                                 
+                                                                    
+    phot(:) = photo(is, :)                                            
+                                                                    
+    CALL update_rconst                                              
+                                                                    
+    dt = time_step_len                                              
+                                                                    
+    ! integrate from t=0 to t=dt                                    
+    CALL integrate(0._dp, dt, icntrl, rcntrl, istatus_u = istatus_u, ierr_u=ierr_u)
+                                                                    
+                                                                    
+   IF (PRESENT(l_debug) .AND. PRESENT(pe)) THEN                       
+      IF (l_debug) CALL error_output(conc(is, :), ierr_u, pe)          
+   ENDIF                                                              
+                                                                      
+    conc(is, :) = c(:)                                                
+                                                                    
+    ! RETURN diagnostic information                                 
+                                                                    
+    IF (PRESENT(ierrf))   ierrf(is) = ierr_u                      
+    IF (PRESENT(xnacc))   xnacc(is) = istatus_u(4)               
+    IF (PRESENT(xnrej))   xnrej(is) = istatus_u(5)               
+                                                                    
+    IF (PRESENT (istatus)) THEN                                   
+      istatus(1:8) = istatus(1:8) + istatus_u(1:8)                
+    ENDIF                                                          
+                                                                    
+  END DO                                                            
+ 
+                                                                    
+! Deallocate input arrays                                           
+                                                                    
+                                                                    
+  data_loaded = .FALSE.                                             
+                                                                    
+  RETURN                                                            
+END SUBROUTINE chem_gasphase_integrate                                        
+
+END MODULE chem_gasphase_mod
+ 
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_simple/chem_gasphase_mod.kpp
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_simple/chem_gasphase_mod.kpp	(revision 3297)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_simple/chem_gasphase_mod.kpp	(revision 3298)
@@ -1,3 +1,7 @@
 //chem_gasphase_mod.kpp
+//
+// Current revision
+// forkel 20.04.2018: added F90_INIT for initialization of fix compounds
+//
 //
 //Former revisions
@@ -11,7 +15,4 @@
 #HESSIAN    on
 #STOICMAT   on
-#INLINE F90_GLOBAL
-  !   Declaration of global variable declarations for photolysis will come from INLINE F90_DATA
-#ENDINLINE
 //
 // *******************************************************************************************
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_simple/simple.eqn
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_simple/simple.eqn	(revision 3297)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_simple/simple.eqn	(revision 3298)
@@ -1,10 +1,11 @@
 {simple.eqn
-Former revisions
+Current revision
 ----------------
- $Id: smog.eqn 2459 2017-09-13 14:10:33Z forkel $
+ 201711   Created simple.eqn with 6 equations forkel
+ 20180316 Added equation no. 7                forkel
 }
 #EQUATIONS
 
-{ very simple mechanism - do NOT show to a chemist! }
+{ home made very simple mechanism - please do not show to a chemist! }
 
   { 1.}  NO2 + hv = NO + O3 :                   phot(j_no2)  ;
@@ -14,2 +15,3 @@
   { 5.}  RO2 + NO = NO2 + RCHO + HO2 :       arr2(4.2E-12_dp, -180.0_dp, temp);
   { 6.}  HO2 + NO = NO2 + OH :               arr2(3.7E-12_dp, -240.0_dp, temp) ;
+  { 7.}  NO2 + OH = HNO3     :               arr2(1.15E-11_dp, 0.0_dp, temp) ;
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_simplep/chem_gasphase_mod.f90
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_simplep/chem_gasphase_mod.f90	(revision 3298)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_simplep/chem_gasphase_mod.f90	(revision 3298)
@@ -0,0 +1,2519 @@
+MODULE chem_gasphase_mod
+ 
+!   Mechanism: simplep
+!
+!------------------------------------------------------------------------------!
+!
+! ******Module chem_gasphase_mod is automatically generated by kpp4palm ******
+!
+!   *********Please do NOT change this Code,it will be ovewritten *********
+!
+!------------------------------------------------------------------------------!
+! This file was created by KPP (http://people.cs.vt.edu/asandu/Software/Kpp/)
+! and kpp4palm (created by Klaus Ketelsen). kpp4palm is an adapted version 
+! of KP4 (JÃ¶ckel,P.,Kerkweg,A.,Pozzer,A.,Sander,R.,Tost,H.,Riede,
+! H.,Baumgaertner,A.,Gromov,S.,and Kern,B.,2010: Development cycle 2 of
+! the Modular Earth Submodel System (MESSy2),Geosci. Model Dev.,3,717-752,
+! https://doi.org/10.5194/gmd-3-717-2010). KP4 is part of the Modular Earth 
+! Submodel System (MESSy),which is is available under the  GNU General Public 
+! License (GPL).
+!
+! KPP is free software; you can redistribute it and/or modify it under the terms 
+! of the General Public Licence as published by the Free Software Foundation; 
+! either version 2 of the License,or (at your option) any later version. 
+! KPP is distributed in the hope that it will be useful,but WITHOUT ANY WARRANTY; 
+! without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 
+! PURPOSE. See the GNU General Public Licence for more details. 
+!
+!------------------------------------------------------------------------------!
+! This file is part of the PALM model system.
+!
+! PALM is free software: you can redistribute it and/or modify it under the
+! terms of the GNU General Public License as published by the Free Software
+! Foundation,either version 3 of the License,or (at your option) any later
+! version.
+!
+! PALM is distributed in the hope that it will be useful,but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not,see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2018 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! ------------------
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id: module_header 2460 2017-09-13 14:47:48Z forkel $
+! forkel June 2018: qvap,fakt added
+! forkel June 2018: reset case in  Initialize,Integrate,Update_rconst
+! 
+! 
+! 2460 2017-09-13 14:47:48Z forkel
+!
+! forkel Sept. 2017: Variables for photolyis added
+!
+!
+! Nov. 2016: Intial version (Klaus Ketelsen)
+!
+!------------------------------------------------------------------------------!
+!
+
+
+! Set kpp Double Precision to PALM Default Precision
+
+  USE kinds,           ONLY: dp=>wp
+
+  USE pegrid,          ONLY: myid, threads_per_task
+
+  IMPLICIT        NONE
+  PRIVATE
+  !SAVE  ! note: occurs again in automatically generated code ...
+
+!  PUBLIC :: IERR_NAMES
+ 
+! PUBLIC :: SPC_NAMES,EQN_NAMES,EQN_TAGS,REQ_HET,REQ_AEROSOL,REQ_PHOTRAT &
+!         ,REQ_MCFCT,IP_MAX,jname
+
+  PUBLIC :: eqn_names, phot_names, spc_names
+  PUBLIC :: nmaxfixsteps
+  PUBLIC :: atol, rtol
+  PUBLIC :: nspec, nreact
+  PUBLIC :: temp
+  PUBLIC :: qvap
+  PUBLIC :: fakt
+  PUBLIC :: phot 
+  PUBLIC :: rconst
+  PUBLIC :: nvar
+  PUBLIC :: nphot
+  PUBLIC :: vl_dim                     ! PUBLIC to ebable other MODULEs to distiguish between scalar and vec
+ 
+  PUBLIC :: initialize, integrate, update_rconst
+  PUBLIC :: chem_gasphase_integrate
+  PUBLIC :: initialize_kpp_ctrl
+
+! END OF MODULE HEADER TEMPLATE
+                                                                 
+! Variables used for vector mode                                 
+                                                                 
+  LOGICAL, PARAMETER          :: l_vector = .FALSE.            
+  INTEGER, PARAMETER          :: i_lu_di = 2
+  INTEGER, PARAMETER          :: vl_dim = 1
+  INTEGER                     :: vl                              
+                                                                 
+  INTEGER                     :: vl_glo                          
+  INTEGER                     :: is, ie                           
+                                                                 
+                                                                 
+  INTEGER, DIMENSION(vl_dim)  :: kacc, krej                       
+  INTEGER, DIMENSION(vl_dim)  :: ierrv                           
+  LOGICAL                     :: data_loaded = .FALSE.             
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Parameter Module File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Parameters.f90
+! Time                 : Tue Sep 25 18:35:48 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! NSPEC - Number of chemical species
+  INTEGER, PARAMETER :: nspec = 12 
+! NVAR - Number of Variable species
+  INTEGER, PARAMETER :: nvar = 10 
+! NVARACT - Number of Active species
+  INTEGER, PARAMETER :: nvaract = 8 
+! NFIX - Number of Fixed species
+  INTEGER, PARAMETER :: nfix = 2 
+! NREACT - Number of reactions
+  INTEGER, PARAMETER :: nreact = 8 
+! NVARST - Starting of variables in conc. vect.
+  INTEGER, PARAMETER :: nvarst = 1 
+! NFIXST - Starting of fixed in conc. vect.
+  INTEGER, PARAMETER :: nfixst = 11 
+! NONZERO - Number of nonzero entries in Jacobian
+  INTEGER, PARAMETER :: nonzero = 36 
+! LU_NONZERO - Number of nonzero entries in LU factoriz. of Jacobian
+  INTEGER, PARAMETER :: lu_nonzero = 38 
+! CNVAR - (NVAR+1) Number of elements in compressed row format
+  INTEGER, PARAMETER :: cnvar = 11 
+! CNEQN - (NREACT+1) Number stoicm elements in compressed col format
+  INTEGER, PARAMETER :: cneqn = 9 
+! NHESS - Length of Sparse Hessian
+  INTEGER, PARAMETER :: nhess = 18 
+! NMASS - Number of atoms to check mass balance
+  INTEGER, PARAMETER :: nmass = 1 
+
+! Index declaration for variable species in C and VAR
+!   VAR(ind_spc) = C(ind_spc)
+
+  INTEGER, PARAMETER, PUBLIC :: ind_pm10 = 1 
+  INTEGER, PARAMETER, PUBLIC :: ind_hno3 = 2 
+  INTEGER, PARAMETER, PUBLIC :: ind_rcho = 3 
+  INTEGER, PARAMETER, PUBLIC :: ind_rh = 4 
+  INTEGER, PARAMETER, PUBLIC :: ind_ho2 = 5 
+  INTEGER, PARAMETER, PUBLIC :: ind_o3 = 6 
+  INTEGER, PARAMETER, PUBLIC :: ind_oh = 7 
+  INTEGER, PARAMETER, PUBLIC :: ind_ro2 = 8 
+  INTEGER, PARAMETER, PUBLIC :: ind_no = 9 
+  INTEGER, PARAMETER, PUBLIC :: ind_no2 = 10 
+
+! Index declaration for fixed species in C
+!   C(ind_spc)
+
+  INTEGER, PARAMETER, PUBLIC :: ind_h2o = 11 
+  INTEGER, PARAMETER, PUBLIC :: ind_o2 = 12 
+
+! Index declaration for fixed species in FIX
+!    FIX(indf_spc) = C(ind_spc) = C(NVAR+indf_spc)
+
+  INTEGER, PARAMETER :: indf_h2o = 1 
+  INTEGER, PARAMETER :: indf_o2 = 2 
+
+! NJVRP - Length of sparse Jacobian JVRP
+  INTEGER, PARAMETER :: njvrp = 13 
+
+! NSTOICM - Length of Sparse Stoichiometric Matrix
+  INTEGER, PARAMETER :: nstoicm = 23 
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Global Data Module File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Global.f90
+! Time                 : Tue Sep 25 18:35:48 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! Declaration of global variables
+
+! C - Concentration of all species
+  REAL(kind=dp):: c(nspec)
+! VAR - Concentrations of variable species (global)
+  REAL(kind=dp):: var(nvar)
+! FIX - Concentrations of fixed species (global)
+  REAL(kind=dp):: fix(nfix)
+! VAR,FIX are chunks of array C
+      EQUIVALENCE( c(1), var(1))
+      EQUIVALENCE( c(11), fix(1))
+! RCONST - Rate constants (global)
+  REAL(kind=dp):: rconst(nreact)
+! TIME - Current integration time
+  REAL(kind=dp):: time
+! TEMP - Temperature
+  REAL(kind=dp):: temp
+! TSTART - Integration start time
+  REAL(kind=dp):: tstart
+! ATOL - Absolute tolerance
+  REAL(kind=dp):: atol(nvar)
+! RTOL - Relative tolerance
+  REAL(kind=dp):: rtol(nvar)
+! STEPMIN - Lower bound for integration step
+  REAL(kind=dp):: stepmin
+! CFACTOR - Conversion factor for concentration units
+  REAL(kind=dp):: cfactor
+
+! INLINED global variable declarations
+
+! QVAP - Water vapor
+  REAL(kind=dp):: qvap
+! FAKT - Conversion factor
+  REAL(kind=dp):: fakt
+
+
+! INLINED global variable declarations
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Sparse Jacobian Data Structures File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_JacobianSP.f90
+! Time                 : Tue Sep 25 18:35:48 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! Sparse Jacobian Data
+
+
+  INTEGER, PARAMETER, DIMENSION(38):: lu_irow =  (/ &
+       1, 2, 2, 2, 3, 3, 3, 4, 4, 5, 5, 5, &
+       6, 6, 6, 7, 7, 7, 7, 7, 7, 7, 8, 8, &
+       8, 8, 8, 9, 9, 9, 9, 9, 10, 10, 10, 10, &
+      10, 10 /) 
+
+  INTEGER, PARAMETER, DIMENSION(38):: lu_icol =  (/ &
+       1, 2, 7, 10, 3, 8, 9, 4, 7, 5, 8, 9, &
+       6, 9, 10, 4, 5, 6, 7, 8, 9, 10, 4, 7, &
+       8, 9, 10, 5, 6, 8, 9, 10, 5, 6, 7, 8, &
+       9, 10 /) 
+
+  INTEGER, PARAMETER, DIMENSION(11):: lu_crow =  (/ &
+       1, 2, 5, 8, 10, 13, 16, 23, 28, 33, 39 /) 
+
+  INTEGER, PARAMETER, DIMENSION(11):: lu_diag =  (/ &
+       1, 2, 5, 8, 10, 13, 19, 25, 31, 38, 39 /) 
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Utility Data Module File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Monitor.f90
+! Time                 : Tue Sep 25 18:35:48 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+  CHARACTER(len=15), PARAMETER, DIMENSION(12):: spc_names =  (/ &
+     'PM10           ','HNO3           ','RCHO           ',&
+     'RH             ','HO2            ','O3             ',&
+     'OH             ','RO2            ','NO             ',&
+     'NO2            ','H2O            ','O2             ' /)
+
+  CHARACTER(len=100), PARAMETER, DIMENSION(8):: eqn_names =  (/ &
+     '     NO2 --> O3 + NO                                                                                ',&
+     '      O3 --> 2 OH + O2                                                                              ',&
+     ' O3 + NO --> NO2                                                                                    ',&
+     ' RH + OH --> RO2 + H2O                                                                              ',&
+     'RO2 + NO --> RCHO + HO2 + NO2                                                                       ',&
+     'HO2 + NO --> OH + NO2                                                                               ',&
+     'OH + NO2 --> HNO3                                                                                   ',&
+     '    PM10 --> PM10                                                                                   ' /)
+
+! INLINED global variables
+
+  !   inline f90_data: declaration of global variables for photolysis
+  !   REAL(kind=dp):: phot(nphot)must eventually be moved to global later for 
+  INTEGER, PARAMETER :: nphot = 2
+  !   phot photolysis frequencies 
+  REAL(kind=dp):: phot(nphot)
+
+  INTEGER, PARAMETER, PUBLIC :: j_no2 = 1
+  INTEGER, PARAMETER, PUBLIC :: j_o31d = 2
+
+  CHARACTER(len=15), PARAMETER, DIMENSION(nphot):: phot_names =   (/ &
+     'J_NO2          ','J_O31D         '/)
+
+! End INLINED global variables
+
+
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+ 
+!  variable definations from  individual module headers 
+ 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Initialization File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Initialize.f90
+! Time                 : Tue Sep 25 18:35:48 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Numerical Integrator (Time-Stepping) File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Integrator.f90
+! Time                 : Tue Sep 25 18:35:48 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! INTEGRATE - Integrator routine
+!   Arguments :
+!      TIN       - Start Time for Integration
+!      TOUT      - End Time for Integration
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
+!  Rosenbrock - Implementation of several Rosenbrock methods:             !
+!               *Ros2                                                    !
+!               *Ros3                                                    !
+!               *Ros4                                                    !
+!               *Rodas3                                                  !
+!               *Rodas4                                                  !
+!  By default the code employs the KPP sparse linear algebra routines     !
+!  Compile with -DFULL_ALGEBRA to use full linear algebra (LAPACK)        !
+!                                                                         !
+!    (C)  Adrian Sandu,August 2004                                       !
+!    Virginia Polytechnic Institute and State University                  !
+!    Contact: sandu@cs.vt.edu                                             !
+!    Revised by Philipp Miehe and Adrian Sandu,May 2006                  !                               !
+!    This implementation is part of KPP - the Kinetic PreProcessor        !
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
+
+
+  SAVE
+  
+!~~~>  statistics on the work performed by the rosenbrock method
+  INTEGER, PARAMETER :: nfun=1, njac=2, nstp=3, nacc=4, &
+                        nrej=5, ndec=6, nsol=7, nsng=8, &
+                        ntexit=1, nhexit=2, nhnew = 3
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Linear Algebra Data and Routines File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_LinearAlgebra.f90
+! Time                 : Tue Sep 25 18:35:48 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! The ODE Jacobian of Chemical Model File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Jacobian.f90
+! Time                 : Tue Sep 25 18:35:48 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! The ODE Function of Chemical Model File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Function.f90
+! Time                 : Tue Sep 25 18:35:48 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+! A - Rate for each equation
+  REAL(kind=dp):: a(nreact)
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! The Reaction Rates File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Rates.f90
+! Time                 : Tue Sep 25 18:35:48 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Auxiliary Routines File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Util.f90
+! Time                 : Tue Sep 25 18:35:48 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+  ! header MODULE initialize_kpp_ctrl_template
+
+  ! notes:
+  ! - l_vector is automatically defined by kp4
+  ! - vl_dim is automatically defined by kp4
+  ! - i_lu_di is automatically defined by kp4
+  ! - wanted is automatically defined by xmecca
+  ! - icntrl rcntrl are automatically defined by kpp
+  ! - "USE messy_main_tools" is in MODULE_header of messy_mecca_kpp.f90
+  ! - SAVE will be automatically added by kp4
+
+  !SAVE
+
+  ! for fixed time step control
+  ! ... max. number of fixed time steps (sum must be 1)
+  INTEGER, PARAMETER         :: nmaxfixsteps = 50
+  ! ... switch for fixed time stepping
+  LOGICAL, PUBLIC            :: l_fixed_step = .FALSE.
+  INTEGER, PUBLIC            :: nfsteps = 1
+  ! ... number of kpp control PARAMETERs
+  INTEGER, PARAMETER, PUBLIC :: nkppctrl = 20
+  !
+  INTEGER, DIMENSION(nkppctrl), PUBLIC     :: icntrl = 0
+  REAL(dp), DIMENSION(nkppctrl), PUBLIC     :: rcntrl = 0.0_dp
+  REAL(dp), DIMENSION(nmaxfixsteps), PUBLIC :: t_steps = 0.0_dp
+
+  ! END header MODULE initialize_kpp_ctrl_template
+
+ 
+! Interface Block 
+ 
+  INTERFACE            initialize
+    MODULE PROCEDURE   initialize
+  END INTERFACE        initialize
+ 
+  INTERFACE            integrate
+    MODULE PROCEDURE   integrate
+  END INTERFACE        integrate
+ 
+  INTERFACE            fun
+    MODULE PROCEDURE   fun
+  END INTERFACE        fun
+ 
+  INTERFACE            kppsolve
+    MODULE PROCEDURE   kppsolve
+  END INTERFACE        kppsolve
+ 
+  INTERFACE            jac_sp
+    MODULE PROCEDURE   jac_sp
+  END INTERFACE        jac_sp
+ 
+  INTERFACE            k_arr
+    MODULE PROCEDURE   k_arr
+  END INTERFACE        k_arr
+ 
+  INTERFACE            update_rconst
+    MODULE PROCEDURE   update_rconst
+  END INTERFACE        update_rconst
+ 
+  INTERFACE            arr2
+    MODULE PROCEDURE   arr2
+  END INTERFACE        arr2
+ 
+  INTERFACE            initialize_kpp_ctrl
+    MODULE PROCEDURE   initialize_kpp_ctrl
+  END INTERFACE        initialize_kpp_ctrl
+ 
+  INTERFACE            error_output
+    MODULE PROCEDURE   error_output
+  END INTERFACE        error_output
+ 
+  INTERFACE            wscal
+    MODULE PROCEDURE   wscal
+  END INTERFACE        wscal
+ 
+!INTERFACE not working  INTERFACE            waxpy
+!INTERFACE not working    MODULE PROCEDURE   waxpy
+!INTERFACE not working  END INTERFACE        waxpy
+ 
+  INTERFACE            rosenbrock
+    MODULE PROCEDURE   rosenbrock
+  END INTERFACE        rosenbrock
+ 
+  INTERFACE            funtemplate
+    MODULE PROCEDURE   funtemplate
+  END INTERFACE        funtemplate
+ 
+  INTERFACE            jactemplate
+    MODULE PROCEDURE   jactemplate
+  END INTERFACE        jactemplate
+ 
+  INTERFACE            kppdecomp
+    MODULE PROCEDURE   kppdecomp
+  END INTERFACE        kppdecomp
+ 
+  INTERFACE            chem_gasphase_integrate
+    MODULE PROCEDURE   chem_gasphase_integrate
+  END INTERFACE        chem_gasphase_integrate
+ 
+ 
+ CONTAINS
+ 
+SUBROUTINE initialize()
+
+
+  INTEGER         :: j, k
+
+  INTEGER :: i
+  REAL(kind=dp):: x
+  k = is
+  cfactor = 1.000000e+00_dp
+
+  x = (0.) * cfactor
+  DO i = 1 , nvar
+  ENDDO
+
+  x = (0.) * cfactor
+  DO i = 1 , nfix
+    fix(i) = x
+  ENDDO
+
+! constant rate coefficients
+! END constant rate coefficients
+
+! INLINED initializations
+
+! End INLINED initializations
+
+      
+END SUBROUTINE initialize
+ 
+SUBROUTINE integrate( tin, tout, &
+  icntrl_u, rcntrl_u, istatus_u, rstatus_u, ierr_u)
+
+
+   REAL(kind=dp), INTENT(IN):: tin  ! start time
+   REAL(kind=dp), INTENT(IN):: tout ! END time
+   ! OPTIONAL input PARAMETERs and statistics
+   INTEGER,      INTENT(IN), OPTIONAL :: icntrl_u(20)
+   REAL(kind=dp), INTENT(IN), OPTIONAL :: rcntrl_u(20)
+   INTEGER,      INTENT(OUT), OPTIONAL :: istatus_u(20)
+   REAL(kind=dp), INTENT(OUT), OPTIONAL :: rstatus_u(20)
+   INTEGER,      INTENT(OUT), OPTIONAL :: ierr_u
+
+   REAL(kind=dp):: rcntrl(20), rstatus(20)
+   INTEGER       :: icntrl(20), istatus(20), ierr
+
+   INTEGER, SAVE :: ntotal = 0
+
+   icntrl(:) = 0
+   rcntrl(:) = 0.0_dp
+   istatus(:) = 0
+   rstatus(:) = 0.0_dp
+
+    !~~~> fine-tune the integrator:
+   icntrl(1) = 0      ! 0 - non- autonomous, 1 - autonomous
+   icntrl(2) = 0      ! 0 - vector tolerances, 1 - scalars
+
+   ! IF OPTIONAL PARAMETERs are given, and IF they are >0, 
+   ! THEN they overwrite default settings. 
+   IF (PRESENT(icntrl_u))THEN
+     WHERE(icntrl_u(:)> 0)icntrl(:) = icntrl_u(:)
+   ENDIF
+   IF (PRESENT(rcntrl_u))THEN
+     WHERE(rcntrl_u(:)> 0)rcntrl(:) = rcntrl_u(:)
+   ENDIF
+
+
+   CALL rosenbrock(nvar, var, tin, tout,  &
+         atol, rtol,               &
+         rcntrl, icntrl, rstatus, istatus, ierr)
+
+   !~~~> debug option: show no of steps
+   ! ntotal = ntotal + istatus(nstp)
+   ! PRINT*,'NSTEPS=',ISTATUS(Nstp),' (',Ntotal,')','  O3=',VAR(ind_O3)
+
+   stepmin = rstatus(nhexit)
+   ! IF OPTIONAL PARAMETERs are given for output they 
+   ! are updated with the RETURN information
+   IF (PRESENT(istatus_u))istatus_u(:) = istatus(:)
+   IF (PRESENT(rstatus_u))rstatus_u(:) = rstatus(:)
+   IF (PRESENT(ierr_u))  ierr_u       = ierr
+
+END SUBROUTINE integrate
+ 
+SUBROUTINE fun(v, f, rct, vdot)
+
+! V - Concentrations of variable species (local)
+  REAL(kind=dp):: v(nvar)
+! F - Concentrations of fixed species (local)
+  REAL(kind=dp):: f(nfix)
+! RCT - Rate constants (local)
+  REAL(kind=dp):: rct(nreact)
+! Vdot - Time derivative of variable species concentrations
+  REAL(kind=dp):: vdot(nvar)
+
+
+! Computation of equation rates
+  a(1) = rct(1) * v(10)
+  a(2) = rct(2) * v(6)
+  a(3) = rct(3) * v(6) * v(9)
+  a(4) = rct(4) * v(4) * v(7)
+  a(5) = rct(5) * v(8) * v(9)
+  a(6) = rct(6) * v(5) * v(9)
+  a(7) = rct(7) * v(7) * v(10)
+
+! Aggregate function
+  vdot(1) = 0
+  vdot(2) = a(7)
+  vdot(3) = a(5)
+  vdot(4) = - a(4)
+  vdot(5) = a(5) - a(6)
+  vdot(6) = a(1) - a(2) - a(3)
+  vdot(7) = 2* a(2) - a(4) + a(6) - a(7)
+  vdot(8) = a(4) - a(5)
+  vdot(9) = a(1) - a(3) - a(5) - a(6)
+  vdot(10) = - a(1) + a(3) + a(5) + a(6) - a(7)
+      
+END SUBROUTINE fun
+ 
+SUBROUTINE kppsolve(jvs, x)
+
+! JVS - sparse Jacobian of variables
+  REAL(kind=dp):: jvs(lu_nonzero)
+! X - Vector for variables
+  REAL(kind=dp):: x(nvar)
+
+  x(7) = x(7) - jvs(16) * x(4) - jvs(17) * x(5) - jvs(18) * x(6)
+  x(8) = x(8) - jvs(23) * x(4) - jvs(24) * x(7)
+  x(9) = x(9) - jvs(28) * x(5) - jvs(29) * x(6) - jvs(30) * x(8)
+  x(10) = x(10) - jvs(33) * x(5) - jvs(34) * x(6) - jvs(35) * x(7) - jvs(36) * x(8) - jvs(37) * x(9)
+  x(10) = x(10) / jvs(38)
+  x(9) = (x(9) - jvs(32) * x(10)) /(jvs(31))
+  x(8) = (x(8) - jvs(26) * x(9) - jvs(27) * x(10)) /(jvs(25))
+  x(7) = (x(7) - jvs(20) * x(8) - jvs(21) * x(9) - jvs(22) * x(10)) /(jvs(19))
+  x(6) = (x(6) - jvs(14) * x(9) - jvs(15) * x(10)) /(jvs(13))
+  x(5) = (x(5) - jvs(11) * x(8) - jvs(12) * x(9)) /(jvs(10))
+  x(4) = (x(4) - jvs(9) * x(7)) /(jvs(8))
+  x(3) = (x(3) - jvs(6) * x(8) - jvs(7) * x(9)) /(jvs(5))
+  x(2) = (x(2) - jvs(3) * x(7) - jvs(4) * x(10)) /(jvs(2))
+  x(1) = x(1) / jvs(1)
+      
+END SUBROUTINE kppsolve
+ 
+SUBROUTINE jac_sp(v, f, rct, jvs)
+
+! V - Concentrations of variable species (local)
+  REAL(kind=dp):: v(nvar)
+! F - Concentrations of fixed species (local)
+  REAL(kind=dp):: f(nfix)
+! RCT - Rate constants (local)
+  REAL(kind=dp):: rct(nreact)
+! JVS - sparse Jacobian of variables
+  REAL(kind=dp):: jvs(lu_nonzero)
+
+
+! Local variables
+! B - Temporary array
+  REAL(kind=dp):: b(13)
+
+! B(1) = dA(1)/dV(10)
+  b(1) = rct(1)
+! B(2) = dA(2)/dV(6)
+  b(2) = rct(2)
+! B(3) = dA(3)/dV(6)
+  b(3) = rct(3) * v(9)
+! B(4) = dA(3)/dV(9)
+  b(4) = rct(3) * v(6)
+! B(5) = dA(4)/dV(4)
+  b(5) = rct(4) * v(7)
+! B(6) = dA(4)/dV(7)
+  b(6) = rct(4) * v(4)
+! B(7) = dA(5)/dV(8)
+  b(7) = rct(5) * v(9)
+! B(8) = dA(5)/dV(9)
+  b(8) = rct(5) * v(8)
+! B(9) = dA(6)/dV(5)
+  b(9) = rct(6) * v(9)
+! B(10) = dA(6)/dV(9)
+  b(10) = rct(6) * v(5)
+! B(11) = dA(7)/dV(7)
+  b(11) = rct(7) * v(10)
+! B(12) = dA(7)/dV(10)
+  b(12) = rct(7) * v(7)
+! B(13) = dA(8)/dV(1)
+  b(13) = rct(8)
+
+! Construct the Jacobian terms from B's
+! JVS(1) = Jac_FULL(1,1)
+  jvs(1) = 0
+! JVS(2) = Jac_FULL(2,2)
+  jvs(2) = 0
+! JVS(3) = Jac_FULL(2,7)
+  jvs(3) = b(11)
+! JVS(4) = Jac_FULL(2,10)
+  jvs(4) = b(12)
+! JVS(5) = Jac_FULL(3,3)
+  jvs(5) = 0
+! JVS(6) = Jac_FULL(3,8)
+  jvs(6) = b(7)
+! JVS(7) = Jac_FULL(3,9)
+  jvs(7) = b(8)
+! JVS(8) = Jac_FULL(4,4)
+  jvs(8) = - b(5)
+! JVS(9) = Jac_FULL(4,7)
+  jvs(9) = - b(6)
+! JVS(10) = Jac_FULL(5,5)
+  jvs(10) = - b(9)
+! JVS(11) = Jac_FULL(5,8)
+  jvs(11) = b(7)
+! JVS(12) = Jac_FULL(5,9)
+  jvs(12) = b(8) - b(10)
+! JVS(13) = Jac_FULL(6,6)
+  jvs(13) = - b(2) - b(3)
+! JVS(14) = Jac_FULL(6,9)
+  jvs(14) = - b(4)
+! JVS(15) = Jac_FULL(6,10)
+  jvs(15) = b(1)
+! JVS(16) = Jac_FULL(7,4)
+  jvs(16) = - b(5)
+! JVS(17) = Jac_FULL(7,5)
+  jvs(17) = b(9)
+! JVS(18) = Jac_FULL(7,6)
+  jvs(18) = 2* b(2)
+! JVS(19) = Jac_FULL(7,7)
+  jvs(19) = - b(6) - b(11)
+! JVS(20) = Jac_FULL(7,8)
+  jvs(20) = 0
+! JVS(21) = Jac_FULL(7,9)
+  jvs(21) = b(10)
+! JVS(22) = Jac_FULL(7,10)
+  jvs(22) = - b(12)
+! JVS(23) = Jac_FULL(8,4)
+  jvs(23) = b(5)
+! JVS(24) = Jac_FULL(8,7)
+  jvs(24) = b(6)
+! JVS(25) = Jac_FULL(8,8)
+  jvs(25) = - b(7)
+! JVS(26) = Jac_FULL(8,9)
+  jvs(26) = - b(8)
+! JVS(27) = Jac_FULL(8,10)
+  jvs(27) = 0
+! JVS(28) = Jac_FULL(9,5)
+  jvs(28) = - b(9)
+! JVS(29) = Jac_FULL(9,6)
+  jvs(29) = - b(3)
+! JVS(30) = Jac_FULL(9,8)
+  jvs(30) = - b(7)
+! JVS(31) = Jac_FULL(9,9)
+  jvs(31) = - b(4) - b(8) - b(10)
+! JVS(32) = Jac_FULL(9,10)
+  jvs(32) = b(1)
+! JVS(33) = Jac_FULL(10,5)
+  jvs(33) = b(9)
+! JVS(34) = Jac_FULL(10,6)
+  jvs(34) = b(3)
+! JVS(35) = Jac_FULL(10,7)
+  jvs(35) = - b(11)
+! JVS(36) = Jac_FULL(10,8)
+  jvs(36) = b(7)
+! JVS(37) = Jac_FULL(10,9)
+  jvs(37) = b(4) + b(8) + b(10)
+! JVS(38) = Jac_FULL(10,10)
+  jvs(38) = - b(1) - b(12)
+      
+END SUBROUTINE jac_sp
+ 
+  elemental REAL(kind=dp)FUNCTION k_arr (k_298, tdep, temp)
+    ! arrhenius FUNCTION
+
+    REAL,    INTENT(IN):: k_298 ! k at t = 298.15k
+    REAL,    INTENT(IN):: tdep  ! temperature dependence
+    REAL(kind=dp), INTENT(IN):: temp  ! temperature
+
+    intrinsic exp
+
+    k_arr = k_298 * exp(tdep* (1._dp/temp- 3.3540e-3_dp))! 1/298.15=3.3540e-3
+
+  END FUNCTION k_arr
+ 
+SUBROUTINE update_rconst()
+ INTEGER         :: k
+
+  k = is
+
+! Begin INLINED RCONST
+
+
+! End INLINED RCONST
+
+  rconst(1) = (phot(j_no2))
+  rconst(2) = (phot(j_o31d))
+  rconst(3) = (arr2(1.8e-12_dp , 1370.0_dp , temp))
+  rconst(4) = (arr2(2.e-11_dp , 500.0_dp , temp))
+  rconst(5) = (arr2(4.2e-12_dp , -180.0_dp , temp))
+  rconst(6) = (arr2(3.7e-12_dp , -240.0_dp , temp))
+  rconst(7) = (arr2(1.15e-11_dp , 0.0_dp , temp))
+  rconst(8) = (1.0_dp)
+      
+END SUBROUTINE update_rconst
+ 
+!  END FUNCTION ARR2
+REAL(kind=dp)FUNCTION arr2( a0, b0, temp)
+    REAL(kind=dp):: temp
+    REAL(kind=dp):: a0, b0
+    arr2 = a0 * exp( - b0 / temp)
+END FUNCTION arr2
+ 
+SUBROUTINE initialize_kpp_ctrl(status)
+
+
+  ! i/o
+  INTEGER,         INTENT(OUT):: status
+
+  ! local
+  REAL(dp):: tsum
+  INTEGER  :: i
+
+  ! check fixed time steps
+  tsum = 0.0_dp
+  DO i=1, nmaxfixsteps
+     IF (t_steps(i)< tiny(0.0_dp))exit
+     tsum = tsum + t_steps(i)
+  ENDDO
+
+  nfsteps = i- 1
+
+  l_fixed_step = (nfsteps > 0).and.((tsum - 1.0)< tiny(0.0_dp))
+
+  IF (l_vector)THEN
+     WRITE(*,*) ' MODE             : VECTOR (LENGTH=',VL_DIM,')'
+  ELSE
+     WRITE(*,*) ' MODE             : SCALAR'
+  ENDIF
+  !
+  WRITE(*,*) ' DE-INDEXING MODE :',I_LU_DI
+  !
+  WRITE(*,*) ' ICNTRL           : ',icntrl
+  WRITE(*,*) ' RCNTRL           : ',rcntrl
+  !
+  ! note: this is ONLY meaningful for vectorized (kp4)rosenbrock- methods
+  IF (l_vector)THEN
+     IF (l_fixed_step)THEN
+        WRITE(*,*) ' TIME STEPS       : FIXED (',t_steps(1:nfsteps),')'
+     ELSE
+        WRITE(*,*) ' TIME STEPS       : AUTOMATIC'
+     ENDIF
+  ELSE
+     WRITE(*,*) ' TIME STEPS       : AUTOMATIC '//&
+          &'(t_steps (CTRL_KPP) ignored in SCALAR MODE)'
+  ENDIF
+  ! mz_pj_20070531- 
+
+  status = 0
+
+
+END SUBROUTINE initialize_kpp_ctrl
+ 
+SUBROUTINE error_output(c, ierr, pe)
+
+
+  INTEGER, INTENT(IN):: ierr
+  INTEGER, INTENT(IN):: pe
+  REAL(dp), DIMENSION(:), INTENT(IN):: c
+
+  write(6,*) 'ERROR in chem_gasphase_mod ',ierr,C(1)
+
+
+END SUBROUTINE error_output
+ 
+      SUBROUTINE wscal(n, alpha, x, incx)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+!     constant times a vector: x(1:N) <- Alpha*x(1:N) 
+!     only for incX=incY=1
+!     after BLAS
+!     replace this by the function from the optimized BLAS implementation:
+!         CALL SSCAL(N,Alpha,X,1) or  CALL DSCAL(N,Alpha,X,1)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+
+      INTEGER  :: i, incx, m, mp1, n
+      REAL(kind=dp) :: x(n), alpha
+      REAL(kind=dp), PARAMETER  :: zero=0.0_dp, one=1.0_dp
+
+      IF (alpha .eq. one)RETURN
+      IF (n .le. 0)RETURN
+
+      m = mod(n, 5)
+      IF ( m .ne. 0)THEN
+        IF (alpha .eq. (- one))THEN
+          DO i = 1, m
+            x(i) = - x(i)
+          ENDDO
+        ELSEIF (alpha .eq. zero)THEN
+          DO i = 1, m
+            x(i) = zero
+          ENDDO
+        ELSE
+          DO i = 1, m
+            x(i) = alpha* x(i)
+          ENDDO
+        ENDIF
+        IF ( n .lt. 5)RETURN
+      ENDIF
+      mp1 = m + 1
+      IF (alpha .eq. (- one))THEN
+        DO i = mp1, n, 5
+          x(i)   = - x(i)
+          x(i + 1) = - x(i + 1)
+          x(i + 2) = - x(i + 2)
+          x(i + 3) = - x(i + 3)
+          x(i + 4) = - x(i + 4)
+        ENDDO
+      ELSEIF (alpha .eq. zero)THEN
+        DO i = mp1, n, 5
+          x(i)   = zero
+          x(i + 1) = zero
+          x(i + 2) = zero
+          x(i + 3) = zero
+          x(i + 4) = zero
+        ENDDO
+      ELSE
+        DO i = mp1, n, 5
+          x(i)   = alpha* x(i)
+          x(i + 1) = alpha* x(i + 1)
+          x(i + 2) = alpha* x(i + 2)
+          x(i + 3) = alpha* x(i + 3)
+          x(i + 4) = alpha* x(i + 4)
+        ENDDO
+      ENDIF
+
+      END SUBROUTINE wscal
+ 
+      SUBROUTINE waxpy(n, alpha, x, incx, y, incy)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+!     constant times a vector plus a vector: y <- y + Alpha*x
+!     only for incX=incY=1
+!     after BLAS
+!     replace this by the function from the optimized BLAS implementation:
+!         CALL SAXPY(N,Alpha,X,1,Y,1) or  CALL DAXPY(N,Alpha,X,1,Y,1)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+
+      INTEGER  :: i, incx, incy, m, mp1, n
+      REAL(kind=dp):: x(n), y(n), alpha
+      REAL(kind=dp), PARAMETER :: zero = 0.0_dp
+
+      IF (alpha .eq. zero)RETURN
+      IF (n .le. 0)RETURN
+
+      m = mod(n, 4)
+      IF ( m .ne. 0)THEN
+        DO i = 1, m
+          y(i) = y(i) + alpha* x(i)
+        ENDDO
+        IF ( n .lt. 4)RETURN
+      ENDIF
+      mp1 = m + 1
+      DO i = mp1, n, 4
+        y(i) = y(i) + alpha* x(i)
+        y(i + 1) = y(i + 1) + alpha* x(i + 1)
+        y(i + 2) = y(i + 2) + alpha* x(i + 2)
+        y(i + 3) = y(i + 3) + alpha* x(i + 3)
+      ENDDO
+      
+      END SUBROUTINE waxpy
+ 
+SUBROUTINE rosenbrock(n, y, tstart, tend, &
+           abstol, reltol,             &
+           rcntrl, icntrl, rstatus, istatus, ierr)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!    Solves the system y'=F(t,y) using a Rosenbrock method defined by:
+!
+!     G = 1/(H*gamma(1)) - Jac(t0,Y0)
+!     T_i = t0 + Alpha(i)*H
+!     Y_i = Y0 + \sum_{j=1}^{i-1} A(i,j)*K_j
+!     G *K_i = Fun( T_i,Y_i)+ \sum_{j=1}^S C(i,j)/H *K_j +
+!         gamma(i)*dF/dT(t0,Y0)
+!     Y1 = Y0 + \sum_{j=1}^S M(j)*K_j
+!
+!    For details on Rosenbrock methods and their implementation consult:
+!      E. Hairer and G. Wanner
+!      "Solving ODEs II. Stiff and differential-algebraic problems".
+!      Springer series in computational mathematics,Springer-Verlag,1996.
+!    The codes contained in the book inspired this implementation.
+!
+!    (C)  Adrian Sandu,August 2004
+!    Virginia Polytechnic Institute and State University
+!    Contact: sandu@cs.vt.edu
+!    Revised by Philipp Miehe and Adrian Sandu,May 2006                  
+!    This implementation is part of KPP - the Kinetic PreProcessor
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!~~~>   input arguments:
+!
+!-     y(n)  = vector of initial conditions (at t=tstart)
+!-    [tstart, tend]  = time range of integration
+!     (if Tstart>Tend the integration is performed backwards in time)
+!-    reltol, abstol = user precribed accuracy
+!- SUBROUTINE  fun( t, y, ydot) = ode FUNCTION, 
+!                       returns Ydot = Y' = F(T,Y)
+!- SUBROUTINE  jac( t, y, jcb) = jacobian of the ode FUNCTION, 
+!                       returns Jcb = dFun/dY
+!-    icntrl(1:20)  = INTEGER inputs PARAMETERs
+!-    rcntrl(1:20)  = REAL inputs PARAMETERs
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!~~~>     output arguments:
+!
+!-    y(n)  - > vector of final states (at t- >tend)
+!-    istatus(1:20) - > INTEGER output PARAMETERs
+!-    rstatus(1:20) - > REAL output PARAMETERs
+!-    ierr            - > job status upon RETURN
+!                        success (positive value) or
+!                        failure (negative value)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!~~~>     input PARAMETERs:
+!
+!    Note: For input parameters equal to zero the default values of the
+!       corresponding variables are used.
+!
+!    ICNTRL(1) = 1: F = F(y)   Independent of T (AUTONOMOUS)
+!              = 0: F = F(t,y) Depends on T (NON-AUTONOMOUS)
+!
+!    ICNTRL(2) = 0: AbsTol,RelTol are N-dimensional vectors
+!              = 1: AbsTol,RelTol are scalars
+!
+!    ICNTRL(3)  -> selection of a particular Rosenbrock method
+!        = 0 :    Rodas3 (default)
+!        = 1 :    Ros2
+!        = 2 :    Ros3
+!        = 3 :    Ros4
+!        = 4 :    Rodas3
+!        = 5 :    Rodas4
+!
+!    ICNTRL(4)  -> maximum number of integration steps
+!        For ICNTRL(4) =0) the default value of 100000 is used
+!
+!    RCNTRL(1)  -> Hmin,lower bound for the integration step size
+!          It is strongly recommended to keep Hmin = ZERO
+!    RCNTRL(2)  -> Hmax,upper bound for the integration step size
+!    RCNTRL(3)  -> Hstart,starting value for the integration step size
+!
+!    RCNTRL(4)  -> FacMin,lower bound on step decrease factor (default=0.2)
+!    RCNTRL(5)  -> FacMax,upper bound on step increase factor (default=6)
+!    RCNTRL(6)  -> FacRej,step decrease factor after multiple rejections
+!                          (default=0.1)
+!    RCNTRL(7)  -> FacSafe,by which the new step is slightly smaller
+!         than the predicted value  (default=0.9)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!
+!    OUTPUT ARGUMENTS:
+!    -----------------
+!
+!    T           -> T value for which the solution has been computed
+!                     (after successful return T=Tend).
+!
+!    Y(N)        -> Numerical solution at T
+!
+!    IDID        -> Reports on successfulness upon return:
+!                    = 1 for success
+!                    < 0 for error (value equals error code)
+!
+!    ISTATUS(1)  -> No. of function calls
+!    ISTATUS(2)  -> No. of jacobian calls
+!    ISTATUS(3)  -> No. of steps
+!    ISTATUS(4)  -> No. of accepted steps
+!    ISTATUS(5)  -> No. of rejected steps (except at very beginning)
+!    ISTATUS(6)  -> No. of LU decompositions
+!    ISTATUS(7)  -> No. of forward/backward substitutions
+!    ISTATUS(8)  -> No. of singular matrix decompositions
+!
+!    RSTATUS(1)  -> Texit,the time corresponding to the
+!                     computed Y upon return
+!    RSTATUS(2)  -> Hexit,last accepted step before exit
+!    RSTATUS(3)  -> Hnew,last predicted step (not yet taken)
+!                   For multiple restarts,use Hnew as Hstart 
+!                     in the subsequent run
+!
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~>  arguments
+   INTEGER,      INTENT(IN)  :: n
+   REAL(kind=dp), INTENT(INOUT):: y(n)
+   REAL(kind=dp), INTENT(IN)  :: tstart, tend
+   REAL(kind=dp), INTENT(IN)  :: abstol(n), reltol(n)
+   INTEGER,      INTENT(IN)  :: icntrl(20)
+   REAL(kind=dp), INTENT(IN)  :: rcntrl(20)
+   INTEGER,      INTENT(INOUT):: istatus(20)
+   REAL(kind=dp), INTENT(INOUT):: rstatus(20)
+   INTEGER, INTENT(OUT) :: ierr
+!~~~>  PARAMETERs of the rosenbrock method, up to 6 stages
+   INTEGER ::  ros_s, rosmethod
+   INTEGER, PARAMETER :: rs2=1, rs3=2, rs4=3, rd3=4, rd4=5, rg3=6
+   REAL(kind=dp):: ros_a(15), ros_c(15), ros_m(6), ros_e(6), &
+                    ros_alpha(6), ros_gamma(6), ros_elo
+   LOGICAL :: ros_newf(6)
+   CHARACTER(len=12):: ros_name
+!~~~>  local variables
+   REAL(kind=dp):: roundoff, facmin, facmax, facrej, facsafe
+   REAL(kind=dp):: hmin, hmax, hstart
+   REAL(kind=dp):: texit
+   INTEGER       :: i, uplimtol, max_no_steps
+   LOGICAL       :: autonomous, vectortol
+!~~~>   PARAMETERs
+   REAL(kind=dp), PARAMETER :: zero = 0.0_dp, one  = 1.0_dp
+   REAL(kind=dp), PARAMETER :: deltamin = 1.0e-5_dp
+
+!~~~>  initialize statistics
+   istatus(1:8) = 0
+   rstatus(1:3) = zero
+
+!~~~>  autonomous or time dependent ode. default is time dependent.
+   autonomous = .not.(icntrl(1) == 0)
+
+!~~~>  for scalar tolerances (icntrl(2).ne.0) the code uses abstol(1)and reltol(1)
+!   For Vector tolerances (ICNTRL(2) == 0) the code uses AbsTol(1:N) and RelTol(1:N)
+   IF (icntrl(2) == 0)THEN
+      vectortol = .TRUE.
+      uplimtol  = n
+   ELSE
+      vectortol = .FALSE.
+      uplimtol  = 1
+   ENDIF
+
+!~~~>   initialize the particular rosenbrock method selected
+   select CASE (icntrl(3))
+     CASE (1)
+       CALL ros2
+     CASE (2)
+       CALL ros3
+     CASE (3)
+       CALL ros4
+     CASE (0, 4)
+       CALL rodas3
+     CASE (5)
+       CALL rodas4
+     CASE (6)
+       CALL rang3
+     CASE default
+       PRINT *,'Unknown Rosenbrock method: ICNTRL(3) =',ICNTRL(3) 
+       CALL ros_errormsg(- 2, tstart, zero, ierr)
+       RETURN
+   END select
+
+!~~~>   the maximum number of steps admitted
+   IF (icntrl(4) == 0)THEN
+      max_no_steps = 200000
+   ELSEIF (icntrl(4)> 0)THEN
+      max_no_steps=icntrl(4)
+   ELSE
+      PRINT *,'User-selected max no. of steps: ICNTRL(4) =',ICNTRL(4)
+      CALL ros_errormsg(- 1, tstart, zero, ierr)
+      RETURN
+   ENDIF
+
+!~~~>  unit roundoff (1+ roundoff>1)
+   roundoff = epsilon(one)
+
+!~~~>  lower bound on the step size: (positive value)
+   IF (rcntrl(1) == zero)THEN
+      hmin = zero
+   ELSEIF (rcntrl(1)> zero)THEN
+      hmin = rcntrl(1)
+   ELSE
+      PRINT *,'User-selected Hmin: RCNTRL(1) =',RCNTRL(1)
+      CALL ros_errormsg(- 3, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  upper bound on the step size: (positive value)
+   IF (rcntrl(2) == zero)THEN
+      hmax = abs(tend-tstart)
+   ELSEIF (rcntrl(2)> zero)THEN
+      hmax = min(abs(rcntrl(2)), abs(tend-tstart))
+   ELSE
+      PRINT *,'User-selected Hmax: RCNTRL(2) =',RCNTRL(2)
+      CALL ros_errormsg(- 3, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  starting step size: (positive value)
+   IF (rcntrl(3) == zero)THEN
+      hstart = max(hmin, deltamin)
+   ELSEIF (rcntrl(3)> zero)THEN
+      hstart = min(abs(rcntrl(3)), abs(tend-tstart))
+   ELSE
+      PRINT *,'User-selected Hstart: RCNTRL(3) =',RCNTRL(3)
+      CALL ros_errormsg(- 3, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  step size can be changed s.t.  facmin < hnew/hold < facmax
+   IF (rcntrl(4) == zero)THEN
+      facmin = 0.2_dp
+   ELSEIF (rcntrl(4)> zero)THEN
+      facmin = rcntrl(4)
+   ELSE
+      PRINT *,'User-selected FacMin: RCNTRL(4) =',RCNTRL(4)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+   IF (rcntrl(5) == zero)THEN
+      facmax = 6.0_dp
+   ELSEIF (rcntrl(5)> zero)THEN
+      facmax = rcntrl(5)
+   ELSE
+      PRINT *,'User-selected FacMax: RCNTRL(5) =',RCNTRL(5)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>   facrej: factor to decrease step after 2 succesive rejections
+   IF (rcntrl(6) == zero)THEN
+      facrej = 0.1_dp
+   ELSEIF (rcntrl(6)> zero)THEN
+      facrej = rcntrl(6)
+   ELSE
+      PRINT *,'User-selected FacRej: RCNTRL(6) =',RCNTRL(6)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>   facsafe: safety factor in the computation of new step size
+   IF (rcntrl(7) == zero)THEN
+      facsafe = 0.9_dp
+   ELSEIF (rcntrl(7)> zero)THEN
+      facsafe = rcntrl(7)
+   ELSE
+      PRINT *,'User-selected FacSafe: RCNTRL(7) =',RCNTRL(7)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  check IF tolerances are reasonable
+    DO i=1, uplimtol
+      IF ((abstol(i)<= zero).or. (reltol(i)<= 10.0_dp* roundoff)&
+         .or. (reltol(i)>= 1.0_dp))THEN
+        PRINT *,' AbsTol(',i,') = ',AbsTol(i)
+        PRINT *,' RelTol(',i,') = ',RelTol(i)
+        CALL ros_errormsg(- 5, tstart, zero, ierr)
+        RETURN
+      ENDIF
+    ENDDO
+
+
+!~~~>  CALL rosenbrock method
+   CALL ros_integrator(y, tstart, tend, texit,  &
+        abstol, reltol,                         &
+!  Integration parameters
+        autonomous, vectortol, max_no_steps,    &
+        roundoff, hmin, hmax, hstart,           &
+        facmin, facmax, facrej, facsafe,        &
+!  Error indicator
+        ierr)
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+CONTAINS !  SUBROUTINEs internal to rosenbrock
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
+ SUBROUTINE ros_errormsg(code, t, h, ierr)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
+!    Handles all error messages
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
+  
+   REAL(kind=dp), INTENT(IN):: t, h
+   INTEGER, INTENT(IN) :: code
+   INTEGER, INTENT(OUT):: ierr
+   
+   ierr = code
+   print * , &
+     'Forced exit from Rosenbrock due to the following error:' 
+     
+   select CASE (code)
+    CASE (- 1)  
+      PRINT *,'--> Improper value for maximal no of steps'
+    CASE (- 2)  
+      PRINT *,'--> Selected Rosenbrock method not implemented'
+    CASE (- 3)  
+      PRINT *,'--> Hmin/Hmax/Hstart must be positive'
+    CASE (- 4)  
+      PRINT *,'--> FacMin/FacMax/FacRej must be positive'
+    CASE (- 5)
+      PRINT *,'--> Improper tolerance values'
+    CASE (- 6)
+      PRINT *,'--> No of steps exceeds maximum bound'
+    CASE (- 7)
+      PRINT *,'--> Step size too small: T + 10*H = T',&
+            ' or H < Roundoff'
+    CASE (- 8)  
+      PRINT *,'--> Matrix is repeatedly singular'
+    CASE default
+      PRINT *,'Unknown Error code: ',Code
+   END select
+   
+   print * , "t=", t, "and h=", h
+     
+ END SUBROUTINE ros_errormsg
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ SUBROUTINE ros_integrator (y, tstart, tend, t, &
+        abstol, reltol,                         &
+!~~~> integration PARAMETERs
+        autonomous, vectortol, max_no_steps,    &
+        roundoff, hmin, hmax, hstart,           &
+        facmin, facmax, facrej, facsafe,        &
+!~~~> error indicator
+        ierr)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!   Template for the implementation of a generic Rosenbrock method
+!      defined by ros_S (no of stages)
+!      and its coefficients ros_{A,C,M,E,Alpha,Gamma}
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~> input: the initial condition at tstart; output: the solution at t
+   REAL(kind=dp), INTENT(INOUT):: y(n)
+!~~~> input: integration interval
+   REAL(kind=dp), INTENT(IN):: tstart, tend
+!~~~> output: time at which the solution is RETURNed (t=tendIF success)
+   REAL(kind=dp), INTENT(OUT)::  t
+!~~~> input: tolerances
+   REAL(kind=dp), INTENT(IN)::  abstol(n), reltol(n)
+!~~~> input: integration PARAMETERs
+   LOGICAL, INTENT(IN):: autonomous, vectortol
+   REAL(kind=dp), INTENT(IN):: hstart, hmin, hmax
+   INTEGER, INTENT(IN):: max_no_steps
+   REAL(kind=dp), INTENT(IN):: roundoff, facmin, facmax, facrej, facsafe
+!~~~> output: error indicator
+   INTEGER, INTENT(OUT):: ierr
+! ~~~~ Local variables
+   REAL(kind=dp):: ynew(n), fcn0(n), fcn(n)
+   REAL(kind=dp):: k(n* ros_s), dfdt(n)
+#ifdef full_algebra    
+   REAL(kind=dp):: jac0(n, n), ghimj(n, n)
+#else
+   REAL(kind=dp):: jac0(lu_nonzero), ghimj(lu_nonzero)
+#endif
+   REAL(kind=dp):: h, hnew, hc, hg, fac, tau
+   REAL(kind=dp):: err, yerr(n)
+   INTEGER :: pivot(n), direction, ioffset, j, istage
+   LOGICAL :: rejectlasth, rejectmoreh, singular
+!~~~>  local PARAMETERs
+   REAL(kind=dp), PARAMETER :: zero = 0.0_dp, one  = 1.0_dp
+   REAL(kind=dp), PARAMETER :: deltamin = 1.0e-5_dp
+!~~~>  locally called FUNCTIONs
+!    REAL(kind=dp) WLAMCH
+!    EXTERNAL WLAMCH
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~>  initial preparations
+   t = tstart
+   rstatus(nhexit) = zero
+   h = min( max(abs(hmin), abs(hstart)), abs(hmax))
+   IF (abs(h)<= 10.0_dp* roundoff)h = deltamin
+
+   IF (tend  >=  tstart)THEN
+     direction = + 1
+   ELSE
+     direction = - 1
+   ENDIF
+   h = direction* h
+
+   rejectlasth=.FALSE.
+   rejectmoreh=.FALSE.
+
+!~~~> time loop begins below
+
+timeloop: DO WHILE((direction > 0).and.((t- tend) + roundoff <= zero)&
+       .or. (direction < 0).and.((tend-t) + roundoff <= zero))
+
+   IF (istatus(nstp)> max_no_steps)THEN  ! too many steps
+      CALL ros_errormsg(- 6, t, h, ierr)
+      RETURN
+   ENDIF
+   IF (((t+ 0.1_dp* h) == t).or.(h <= roundoff))THEN  ! step size too small
+      CALL ros_errormsg(- 7, t, h, ierr)
+      RETURN
+   ENDIF
+
+!~~~>  limit h IF necessary to avoid going beyond tend
+   h = min(h, abs(tend-t))
+
+!~~~>   compute the FUNCTION at current time
+   CALL funtemplate(t, y, fcn0)
+   istatus(nfun) = istatus(nfun) + 1
+
+!~~~>  compute the FUNCTION derivative with respect to t
+   IF (.not.autonomous)THEN
+      CALL ros_funtimederivative(t, roundoff, y, &
+                fcn0, dfdt)
+   ENDIF
+
+!~~~>   compute the jacobian at current time
+   CALL jactemplate(t, y, jac0)
+   istatus(njac) = istatus(njac) + 1
+
+!~~~>  repeat step calculation until current step accepted
+untilaccepted: do
+
+   CALL ros_preparematrix(h, direction, ros_gamma(1), &
+          jac0, ghimj, pivot, singular)
+   IF (singular)THEN ! more than 5 consecutive failed decompositions
+       CALL ros_errormsg(- 8, t, h, ierr)
+       RETURN
+   ENDIF
+
+!~~~>   compute the stages
+stage: DO istage = 1, ros_s
+
+      ! current istage offset. current istage vector is k(ioffset+ 1:ioffset+ n)
+       ioffset = n* (istage-1)
+
+      ! for the 1st istage the FUNCTION has been computed previously
+       IF (istage == 1)THEN
+         !slim: CALL wcopy(n, fcn0, 1, fcn, 1)
+       fcn(1:n) = fcn0(1:n)
+      ! istage>1 and a new FUNCTION evaluation is needed at the current istage
+       ELSEIF(ros_newf(istage))THEN
+         !slim: CALL wcopy(n, y, 1, ynew, 1)
+       ynew(1:n) = y(1:n)
+         DO j = 1, istage-1
+           CALL waxpy(n, ros_a((istage-1) * (istage-2) /2+ j), &
+            k(n* (j- 1) + 1), 1, ynew, 1)
+         ENDDO
+         tau = t + ros_alpha(istage) * direction* h
+         CALL funtemplate(tau, ynew, fcn)
+         istatus(nfun) = istatus(nfun) + 1
+       ENDIF ! IF istage == 1 ELSEIF ros_newf(istage)
+       !slim: CALL wcopy(n, fcn, 1, k(ioffset+ 1), 1)
+       k(ioffset+ 1:ioffset+ n) = fcn(1:n)
+       DO j = 1, istage-1
+         hc = ros_c((istage-1) * (istage-2) /2+ j) /(direction* h)
+         CALL waxpy(n, hc, k(n* (j- 1) + 1), 1, k(ioffset+ 1), 1)
+       ENDDO
+       IF ((.not. autonomous).and.(ros_gamma(istage).ne.zero))THEN
+         hg = direction* h* ros_gamma(istage)
+         CALL waxpy(n, hg, dfdt, 1, k(ioffset+ 1), 1)
+       ENDIF
+       CALL ros_solve(ghimj, pivot, k(ioffset+ 1))
+
+   END DO stage
+
+
+!~~~>  compute the new solution
+   !slim: CALL wcopy(n, y, 1, ynew, 1)
+   ynew(1:n) = y(1:n)
+   DO j=1, ros_s
+         CALL waxpy(n, ros_m(j), k(n* (j- 1) + 1), 1, ynew, 1)
+   ENDDO
+
+!~~~>  compute the error estimation
+   !slim: CALL wscal(n, zero, yerr, 1)
+   yerr(1:n) = zero
+   DO j=1, ros_s
+        CALL waxpy(n, ros_e(j), k(n* (j- 1) + 1), 1, yerr, 1)
+   ENDDO
+   err = ros_errornorm(y, ynew, yerr, abstol, reltol, vectortol)
+
+!~~~> new step size is bounded by facmin <= hnew/h <= facmax
+   fac  = min(facmax, max(facmin, facsafe/err** (one/ros_elo)))
+   hnew = h* fac
+
+!~~~>  check the error magnitude and adjust step size
+   istatus(nstp) = istatus(nstp) + 1
+   IF ((err <= one).or.(h <= hmin))THEN  !~~~> accept step
+      istatus(nacc) = istatus(nacc) + 1
+      !slim: CALL wcopy(n, ynew, 1, y, 1)
+      y(1:n) = ynew(1:n)
+      t = t + direction* h
+      hnew = max(hmin, min(hnew, hmax))
+      IF (rejectlasth)THEN  ! no step size increase after a rejected step
+         hnew = min(hnew, h)
+      ENDIF
+      rstatus(nhexit) = h
+      rstatus(nhnew) = hnew
+      rstatus(ntexit) = t
+      rejectlasth = .FALSE.
+      rejectmoreh = .FALSE.
+      h = hnew
+      exit untilaccepted ! exit the loop: WHILE step not accepted
+   ELSE           !~~~> reject step
+      IF (rejectmoreh)THEN
+         hnew = h* facrej
+      ENDIF
+      rejectmoreh = rejectlasth
+      rejectlasth = .TRUE.
+      h = hnew
+      IF (istatus(nacc)>= 1) istatus(nrej) = istatus(nrej) + 1
+   ENDIF ! err <= 1
+
+   END DO untilaccepted
+
+   END DO timeloop
+
+!~~~> succesful exit
+   ierr = 1  !~~~> the integration was successful
+
+  END SUBROUTINE ros_integrator
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  REAL(kind=dp)FUNCTION ros_errornorm(y, ynew, yerr, &
+                               abstol, reltol, vectortol)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> computes the "scaled norm" of the error vector yerr
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+! Input arguments
+   REAL(kind=dp), INTENT(IN):: y(n), ynew(n), &
+          yerr(n), abstol(n), reltol(n)
+   LOGICAL, INTENT(IN)::  vectortol
+! Local variables
+   REAL(kind=dp):: err, scale, ymax
+   INTEGER  :: i
+   REAL(kind=dp), PARAMETER :: zero = 0.0_dp
+
+   err = zero
+   DO i=1, n
+     ymax = max(abs(y(i)), abs(ynew(i)))
+     IF (vectortol)THEN
+       scale = abstol(i) + reltol(i) * ymax
+     ELSE
+       scale = abstol(1) + reltol(1) * ymax
+     ENDIF
+     err = err+ (yerr(i) /scale) ** 2
+   ENDDO
+   err  = sqrt(err/n)
+
+   ros_errornorm = max(err, 1.0d-10)
+
+  END FUNCTION ros_errornorm
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_funtimederivative(t, roundoff, y, &
+                fcn0, dfdt)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> the time partial derivative of the FUNCTION by finite differences
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+!~~~> input arguments
+   REAL(kind=dp), INTENT(IN):: t, roundoff, y(n), fcn0(n)
+!~~~> output arguments
+   REAL(kind=dp), INTENT(OUT):: dfdt(n)
+!~~~> local variables
+   REAL(kind=dp):: delta
+   REAL(kind=dp), PARAMETER :: one = 1.0_dp, deltamin = 1.0e-6_dp
+
+   delta = sqrt(roundoff) * max(deltamin, abs(t))
+   CALL funtemplate(t+ delta, y, dfdt)
+   istatus(nfun) = istatus(nfun) + 1
+   CALL waxpy(n, (- one), fcn0, 1, dfdt, 1)
+   CALL wscal(n, (one/delta), dfdt, 1)
+
+  END SUBROUTINE ros_funtimederivative
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_preparematrix(h, direction, gam, &
+             jac0, ghimj, pivot, singular)
+! --- --- --- --- --- --- --- --- --- --- --- --- ---
+!  Prepares the LHS matrix for stage calculations
+!  1.  Construct Ghimj = 1/(H*ham) - Jac0
+!      "(Gamma H) Inverse Minus Jacobian"
+!  2.  Repeat LU decomposition of Ghimj until successful.
+!       -half the step size if LU decomposition fails and retry
+!       -exit after 5 consecutive fails
+! --- --- --- --- --- --- --- --- --- --- --- --- ---
+
+!~~~> input arguments
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(IN)::  jac0(n, n)
+#else
+   REAL(kind=dp), INTENT(IN)::  jac0(lu_nonzero)
+#endif   
+   REAL(kind=dp), INTENT(IN)::  gam
+   INTEGER, INTENT(IN)::  direction
+!~~~> output arguments
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(OUT):: ghimj(n, n)
+#else
+   REAL(kind=dp), INTENT(OUT):: ghimj(lu_nonzero)
+#endif   
+   LOGICAL, INTENT(OUT)::  singular
+   INTEGER, INTENT(OUT)::  pivot(n)
+!~~~> inout arguments
+   REAL(kind=dp), INTENT(INOUT):: h   ! step size is decreased when lu fails
+!~~~> local variables
+   INTEGER  :: i, ising, nconsecutive
+   REAL(kind=dp):: ghinv
+   REAL(kind=dp), PARAMETER :: one  = 1.0_dp, half = 0.5_dp
+
+   nconsecutive = 0
+   singular = .TRUE.
+
+   DO WHILE (singular)
+
+!~~~>    construct ghimj = 1/(h* gam) - jac0
+#ifdef full_algebra    
+     !slim: CALL wcopy(n* n, jac0, 1, ghimj, 1)
+     !slim: CALL wscal(n* n, (- one), ghimj, 1)
+     ghimj = - jac0
+     ghinv = one/(direction* h* gam)
+     DO i=1, n
+       ghimj(i, i) = ghimj(i, i) + ghinv
+     ENDDO
+#else
+     !slim: CALL wcopy(lu_nonzero, jac0, 1, ghimj, 1)
+     !slim: CALL wscal(lu_nonzero, (- one), ghimj, 1)
+     ghimj(1:lu_nonzero) = - jac0(1:lu_nonzero)
+     ghinv = one/(direction* h* gam)
+     DO i=1, n
+       ghimj(lu_diag(i)) = ghimj(lu_diag(i)) + ghinv
+     ENDDO
+#endif   
+!~~~>    compute lu decomposition
+     CALL ros_decomp( ghimj, pivot, ising)
+     IF (ising == 0)THEN
+!~~~>    IF successful done
+        singular = .FALSE.
+     ELSE ! ising .ne. 0
+!~~~>    IF unsuccessful half the step size; IF 5 consecutive fails THEN RETURN
+        istatus(nsng) = istatus(nsng) + 1
+        nconsecutive = nconsecutive+1
+        singular = .TRUE.
+        PRINT*,'Warning: LU Decomposition returned ISING = ',ISING
+        IF (nconsecutive <= 5)THEN ! less than 5 consecutive failed decompositions
+           h = h* half
+        ELSE  ! more than 5 consecutive failed decompositions
+           RETURN
+        ENDIF  ! nconsecutive
+      ENDIF    ! ising
+
+   END DO ! WHILE singular
+
+  END SUBROUTINE ros_preparematrix
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_decomp( a, pivot, ising)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the LU decomposition
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> inout variables
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(INOUT):: a(n, n)
+#else   
+   REAL(kind=dp), INTENT(INOUT):: a(lu_nonzero)
+#endif
+!~~~> output variables
+   INTEGER, INTENT(OUT):: pivot(n), ising
+
+#ifdef full_algebra    
+   CALL  dgetrf( n, n, a, n, pivot, ising)
+#else   
+   CALL kppdecomp(a, ising)
+   pivot(1) = 1
+#endif
+   istatus(ndec) = istatus(ndec) + 1
+
+  END SUBROUTINE ros_decomp
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_solve( a, pivot, b)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the forward/backward substitution (using pre-computed LU decomposition)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> input variables
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(IN):: a(n, n)
+   INTEGER :: ising
+#else   
+   REAL(kind=dp), INTENT(IN):: a(lu_nonzero)
+#endif
+   INTEGER, INTENT(IN):: pivot(n)
+!~~~> inout variables
+   REAL(kind=dp), INTENT(INOUT):: b(n)
+
+#ifdef full_algebra    
+   CALL  DGETRS( 'N',N ,1,A,N,Pivot,b,N,ISING)
+   IF (info < 0)THEN
+      print* , "error in dgetrs. ising=", ising
+   ENDIF  
+#else   
+   CALL kppsolve( a, b)
+#endif
+
+   istatus(nsol) = istatus(nsol) + 1
+
+  END SUBROUTINE ros_solve
+
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros2
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! --- AN L-STABLE METHOD,2 stages,order 2
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+   double precision g
+
+    g = 1.0_dp + 1.0_dp/sqrt(2.0_dp)
+    rosmethod = rs2
+!~~~> name of the method
+    ros_Name = 'ROS-2'
+!~~~> number of stages
+    ros_s = 2
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+    ros_a(1) = (1.0_dp) /g
+    ros_c(1) = (- 2.0_dp) /g
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+    ros_newf(1) = .TRUE.
+    ros_newf(2) = .TRUE.
+!~~~> m_i = coefficients for new step solution
+    ros_m(1) = (3.0_dp) /(2.0_dp* g)
+    ros_m(2) = (1.0_dp) /(2.0_dp* g)
+! E_i = Coefficients for error estimator
+    ros_e(1) = 1.0_dp/(2.0_dp* g)
+    ros_e(2) = 1.0_dp/(2.0_dp* g)
+!~~~> ros_elo = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus one
+    ros_elo = 2.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+    ros_alpha(1) = 0.0_dp
+    ros_alpha(2) = 1.0_dp
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+    ros_gamma(1) = g
+    ros_gamma(2) = -g
+
+ END SUBROUTINE ros2
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! --- AN L-STABLE METHOD,3 stages,order 3,2 function evaluations
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+   rosmethod = rs3
+!~~~> name of the method
+   ros_Name = 'ROS-3'
+!~~~> number of stages
+   ros_s = 3
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+   ros_a(1) = 1.0_dp
+   ros_a(2) = 1.0_dp
+   ros_a(3) = 0.0_dp
+
+   ros_c(1) = - 0.10156171083877702091975600115545e+01_dp
+   ros_c(2) =  0.40759956452537699824805835358067e+01_dp
+   ros_c(3) =  0.92076794298330791242156818474003e+01_dp
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+   ros_newf(1) = .TRUE.
+   ros_newf(2) = .TRUE.
+   ros_newf(3) = .FALSE.
+!~~~> m_i = coefficients for new step solution
+   ros_m(1) =  0.1e+01_dp
+   ros_m(2) =  0.61697947043828245592553615689730e+01_dp
+   ros_m(3) = - 0.42772256543218573326238373806514_dp
+! E_i = Coefficients for error estimator
+   ros_e(1) =  0.5_dp
+   ros_e(2) = - 0.29079558716805469821718236208017e+01_dp
+   ros_e(3) =  0.22354069897811569627360909276199_dp
+!~~~> ros_elo = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus 1
+   ros_elo = 3.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+   ros_alpha(1) = 0.0_dp
+   ros_alpha(2) = 0.43586652150845899941601945119356_dp
+   ros_alpha(3) = 0.43586652150845899941601945119356_dp
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+   ros_gamma(1) = 0.43586652150845899941601945119356_dp
+   ros_gamma(2) = 0.24291996454816804366592249683314_dp
+   ros_gamma(3) = 0.21851380027664058511513169485832e+01_dp
+
+  END SUBROUTINE ros3
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros4
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     L-STABLE ROSENBROCK METHOD OF ORDER 4,WITH 4 STAGES
+!     L-STABLE EMBEDDED ROSENBROCK METHOD OF ORDER 3
+!
+!      E. HAIRER AND G. WANNER,SOLVING ORDINARY DIFFERENTIAL
+!      EQUATIONS II. STIFF AND DIFFERENTIAL-ALGEBRAIC PROBLEMS.
+!      SPRINGER SERIES IN COMPUTATIONAL MATHEMATICS,
+!      SPRINGER-VERLAG (1990)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+   rosmethod = rs4
+!~~~> name of the method
+   ros_Name = 'ROS-4'
+!~~~> number of stages
+   ros_s = 4
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+   ros_a(1) = 0.2000000000000000e+01_dp
+   ros_a(2) = 0.1867943637803922e+01_dp
+   ros_a(3) = 0.2344449711399156_dp
+   ros_a(4) = ros_a(2)
+   ros_a(5) = ros_a(3)
+   ros_a(6) = 0.0_dp
+
+   ros_c(1) = -0.7137615036412310e+01_dp
+   ros_c(2) = 0.2580708087951457e+01_dp
+   ros_c(3) = 0.6515950076447975_dp
+   ros_c(4) = -0.2137148994382534e+01_dp
+   ros_c(5) = -0.3214669691237626_dp
+   ros_c(6) = -0.6949742501781779_dp
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+   ros_newf(1) = .TRUE.
+   ros_newf(2) = .TRUE.
+   ros_newf(3) = .TRUE.
+   ros_newf(4) = .FALSE.
+!~~~> m_i = coefficients for new step solution
+   ros_m(1) = 0.2255570073418735e+01_dp
+   ros_m(2) = 0.2870493262186792_dp
+   ros_m(3) = 0.4353179431840180_dp
+   ros_m(4) = 0.1093502252409163e+01_dp
+!~~~> e_i  = coefficients for error estimator
+   ros_e(1) = -0.2815431932141155_dp
+   ros_e(2) = -0.7276199124938920e-01_dp
+   ros_e(3) = -0.1082196201495311_dp
+   ros_e(4) = -0.1093502252409163e+01_dp
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus 1
+   ros_elo  = 4.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+   ros_alpha(1) = 0.0_dp
+   ros_alpha(2) = 0.1145640000000000e+01_dp
+   ros_alpha(3) = 0.6552168638155900_dp
+   ros_alpha(4) = ros_alpha(3)
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+   ros_gamma(1) = 0.5728200000000000_dp
+   ros_gamma(2) = -0.1769193891319233e+01_dp
+   ros_gamma(3) = 0.7592633437920482_dp
+   ros_gamma(4) = -0.1049021087100450_dp
+
+  END SUBROUTINE ros4
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE rodas3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! --- A STIFFLY-STABLE METHOD,4 stages,order 3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+   rosmethod = rd3
+!~~~> name of the method
+   ros_Name = 'RODAS-3'
+!~~~> number of stages
+   ros_s = 4
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+   ros_a(1) = 0.0_dp
+   ros_a(2) = 2.0_dp
+   ros_a(3) = 0.0_dp
+   ros_a(4) = 2.0_dp
+   ros_a(5) = 0.0_dp
+   ros_a(6) = 1.0_dp
+
+   ros_c(1) = 4.0_dp
+   ros_c(2) = 1.0_dp
+   ros_c(3) = -1.0_dp
+   ros_c(4) = 1.0_dp
+   ros_c(5) = -1.0_dp
+   ros_c(6) = -(8.0_dp/3.0_dp)
+
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+   ros_newf(1) = .TRUE.
+   ros_newf(2) = .FALSE.
+   ros_newf(3) = .TRUE.
+   ros_newf(4) = .TRUE.
+!~~~> m_i = coefficients for new step solution
+   ros_m(1) = 2.0_dp
+   ros_m(2) = 0.0_dp
+   ros_m(3) = 1.0_dp
+   ros_m(4) = 1.0_dp
+!~~~> e_i  = coefficients for error estimator
+   ros_e(1) = 0.0_dp
+   ros_e(2) = 0.0_dp
+   ros_e(3) = 0.0_dp
+   ros_e(4) = 1.0_dp
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus 1
+   ros_elo  = 3.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+   ros_alpha(1) = 0.0_dp
+   ros_alpha(2) = 0.0_dp
+   ros_alpha(3) = 1.0_dp
+   ros_alpha(4) = 1.0_dp
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+   ros_gamma(1) = 0.5_dp
+   ros_gamma(2) = 1.5_dp
+   ros_gamma(3) = 0.0_dp
+   ros_gamma(4) = 0.0_dp
+
+  END SUBROUTINE rodas3
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE rodas4
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     STIFFLY-STABLE ROSENBROCK METHOD OF ORDER 4,WITH 6 STAGES
+!
+!      E. HAIRER AND G. WANNER,SOLVING ORDINARY DIFFERENTIAL
+!      EQUATIONS II. STIFF AND DIFFERENTIAL-ALGEBRAIC PROBLEMS.
+!      SPRINGER SERIES IN COMPUTATIONAL MATHEMATICS,
+!      SPRINGER-VERLAG (1996)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+    rosmethod = rd4
+!~~~> name of the method
+    ros_Name = 'RODAS-4'
+!~~~> number of stages
+    ros_s = 6
+
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+    ros_alpha(1) = 0.000_dp
+    ros_alpha(2) = 0.386_dp
+    ros_alpha(3) = 0.210_dp
+    ros_alpha(4) = 0.630_dp
+    ros_alpha(5) = 1.000_dp
+    ros_alpha(6) = 1.000_dp
+
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+    ros_gamma(1) = 0.2500000000000000_dp
+    ros_gamma(2) = -0.1043000000000000_dp
+    ros_gamma(3) = 0.1035000000000000_dp
+    ros_gamma(4) = -0.3620000000000023e-01_dp
+    ros_gamma(5) = 0.0_dp
+    ros_gamma(6) = 0.0_dp
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:  A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!                  C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+    ros_a(1) = 0.1544000000000000e+01_dp
+    ros_a(2) = 0.9466785280815826_dp
+    ros_a(3) = 0.2557011698983284_dp
+    ros_a(4) = 0.3314825187068521e+01_dp
+    ros_a(5) = 0.2896124015972201e+01_dp
+    ros_a(6) = 0.9986419139977817_dp
+    ros_a(7) = 0.1221224509226641e+01_dp
+    ros_a(8) = 0.6019134481288629e+01_dp
+    ros_a(9) = 0.1253708332932087e+02_dp
+    ros_a(10) = -0.6878860361058950_dp
+    ros_a(11) = ros_a(7)
+    ros_a(12) = ros_a(8)
+    ros_a(13) = ros_a(9)
+    ros_a(14) = ros_a(10)
+    ros_a(15) = 1.0_dp
+
+    ros_c(1) = -0.5668800000000000e+01_dp
+    ros_c(2) = -0.2430093356833875e+01_dp
+    ros_c(3) = -0.2063599157091915_dp
+    ros_c(4) = -0.1073529058151375_dp
+    ros_c(5) = -0.9594562251023355e+01_dp
+    ros_c(6) = -0.2047028614809616e+02_dp
+    ros_c(7) = 0.7496443313967647e+01_dp
+    ros_c(8) = -0.1024680431464352e+02_dp
+    ros_c(9) = -0.3399990352819905e+02_dp
+    ros_c(10) = 0.1170890893206160e+02_dp
+    ros_c(11) = 0.8083246795921522e+01_dp
+    ros_c(12) = -0.7981132988064893e+01_dp
+    ros_c(13) = -0.3152159432874371e+02_dp
+    ros_c(14) = 0.1631930543123136e+02_dp
+    ros_c(15) = -0.6058818238834054e+01_dp
+
+!~~~> m_i = coefficients for new step solution
+    ros_m(1) = ros_a(7)
+    ros_m(2) = ros_a(8)
+    ros_m(3) = ros_a(9)
+    ros_m(4) = ros_a(10)
+    ros_m(5) = 1.0_dp
+    ros_m(6) = 1.0_dp
+
+!~~~> e_i  = coefficients for error estimator
+    ros_e(1) = 0.0_dp
+    ros_e(2) = 0.0_dp
+    ros_e(3) = 0.0_dp
+    ros_e(4) = 0.0_dp
+    ros_e(5) = 0.0_dp
+    ros_e(6) = 1.0_dp
+
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+    ros_newf(1) = .TRUE.
+    ros_newf(2) = .TRUE.
+    ros_newf(3) = .TRUE.
+    ros_newf(4) = .TRUE.
+    ros_newf(5) = .TRUE.
+    ros_newf(6) = .TRUE.
+
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!        main and the embedded scheme orders plus 1
+    ros_elo = 4.0_dp
+
+  END SUBROUTINE rodas4
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE rang3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! STIFFLY-STABLE W METHOD OF ORDER 3,WITH 4 STAGES
+!
+! J. RANG and L. ANGERMANN
+! NEW ROSENBROCK W-METHODS OF ORDER 3
+! FOR PARTIAL DIFFERENTIAL ALGEBRAIC
+!        EQUATIONS OF INDEX 1                                             
+! BIT Numerical Mathematics (2005) 45: 761-787
+!  DOI: 10.1007/s10543-005-0035-y
+! Table 4.1-4.2
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+    rosmethod = rg3
+!~~~> name of the method
+    ros_Name = 'RANG-3'
+!~~~> number of stages
+    ros_s = 4
+
+    ros_a(1) = 5.09052051067020d+00;
+    ros_a(2) = 5.09052051067020d+00;
+    ros_a(3) = 0.0d0;
+    ros_a(4) = 4.97628111010787d+00;
+    ros_a(5) = 2.77268164715849d-02;
+    ros_a(6) = 2.29428036027904d-01;
+
+    ros_c(1) = - 1.16790812312283d+01;
+    ros_c(2) = - 1.64057326467367d+01;
+    ros_c(3) = - 2.77268164715850d-01;
+    ros_c(4) = - 8.38103960500476d+00;
+    ros_c(5) = - 8.48328409199343d-01;
+    ros_c(6) =  2.87009860433106d-01;
+
+    ros_m(1) =  5.22582761233094d+00;
+    ros_m(2) = - 5.56971148154165d-01;
+    ros_m(3) =  3.57979469353645d-01;
+    ros_m(4) =  1.72337398521064d+00;
+
+    ros_e(1) = - 5.16845212784040d+00;
+    ros_e(2) = - 1.26351942603842d+00;
+    ros_e(3) = - 1.11022302462516d-16;
+    ros_e(4) =  2.22044604925031d-16;
+
+    ros_alpha(1) = 0.0d00;
+    ros_alpha(2) = 2.21878746765329d+00;
+    ros_alpha(3) = 2.21878746765329d+00;
+    ros_alpha(4) = 1.55392337535788d+00;
+
+    ros_gamma(1) =  4.35866521508459d-01;
+    ros_gamma(2) = - 1.78292094614483d+00;
+    ros_gamma(3) = - 2.46541900496934d+00;
+    ros_gamma(4) = - 8.05529997906370d-01;
+
+
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+    ros_newf(1) = .TRUE.
+    ros_newf(2) = .TRUE.
+    ros_newf(3) = .TRUE.
+    ros_newf(4) = .TRUE.
+
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!        main and the embedded scheme orders plus 1
+    ros_elo = 3.0_dp
+
+  END SUBROUTINE rang3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!   End of the set of internal Rosenbrock subroutines
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END SUBROUTINE rosenbrock
+ 
+SUBROUTINE funtemplate( t, y, ydot)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the ODE function call.
+!  Updates the rate coefficients (and possibly the fixed species) at each call
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> input variables
+   REAL(kind=dp):: t, y(nvar)
+!~~~> output variables
+   REAL(kind=dp):: ydot(nvar)
+!~~~> local variables
+   REAL(kind=dp):: told
+
+   told = time
+   time = t
+   CALL fun( y, fix, rconst, ydot)
+   time = told
+
+END SUBROUTINE funtemplate
+ 
+SUBROUTINE jactemplate( t, y, jcb)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the ODE Jacobian call.
+!  Updates the rate coefficients (and possibly the fixed species) at each call
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> input variables
+    REAL(kind=dp):: t, y(nvar)
+!~~~> output variables
+#ifdef full_algebra    
+    REAL(kind=dp):: jv(lu_nonzero), jcb(nvar, nvar)
+#else
+    REAL(kind=dp):: jcb(lu_nonzero)
+#endif   
+!~~~> local variables
+    REAL(kind=dp):: told
+#ifdef full_algebra    
+    INTEGER :: i, j
+#endif   
+
+    told = time
+    time = t
+#ifdef full_algebra    
+    CALL jac_sp(y, fix, rconst, jv)
+    DO j=1, nvar
+      DO i=1, nvar
+         jcb(i, j) = 0.0_dp
+      ENDDO
+    ENDDO
+    DO i=1, lu_nonzero
+       jcb(lu_irow(i), lu_icol(i)) = jv(i)
+    ENDDO
+#else
+    CALL jac_sp( y, fix, rconst, jcb)
+#endif   
+    time = told
+
+END SUBROUTINE jactemplate
+ 
+  SUBROUTINE kppdecomp( jvs, ier)                                    
+  ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
+  !        sparse lu factorization                                    
+  ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
+  ! loop expansion generated by kp4                                   
+                                                                      
+    INTEGER  :: ier                                                   
+    REAL(kind=dp):: jvs(lu_nonzero), w(nvar), a             
+    INTEGER  :: k, kk, j, jj                                          
+                                                                      
+    a = 0.                                                            
+    ier = 0                                                           
+                                                                      
+!   i = 1
+!   i = 2
+!   i = 3
+!   i = 4
+!   i = 5
+!   i = 6
+!   i = 7
+    jvs(16) = (jvs(16)) / jvs(8) 
+    jvs(17) = (jvs(17)) / jvs(10) 
+    jvs(18) = (jvs(18)) / jvs(13) 
+    jvs(19) = jvs(19) - jvs(9) * jvs(16)
+    jvs(20) = jvs(20) - jvs(11) * jvs(17)
+    jvs(21) = jvs(21) - jvs(12) * jvs(17) - jvs(14) * jvs(18)
+    jvs(22) = jvs(22) - jvs(15) * jvs(18)
+!   i = 8
+    jvs(23) = (jvs(23)) / jvs(8) 
+    a = 0.0; a = a  - jvs(9) * jvs(23)
+    jvs(24) = (jvs(24) + a) / jvs(19) 
+    jvs(25) = jvs(25) - jvs(20) * jvs(24)
+    jvs(26) = jvs(26) - jvs(21) * jvs(24)
+    jvs(27) = jvs(27) - jvs(22) * jvs(24)
+!   i = 9
+    jvs(28) = (jvs(28)) / jvs(10) 
+    jvs(29) = (jvs(29)) / jvs(13) 
+    a = 0.0; a = a  - jvs(11) * jvs(28)
+    jvs(30) = (jvs(30) + a) / jvs(25) 
+    jvs(31) = jvs(31) - jvs(12) * jvs(28) - jvs(14) * jvs(29) - jvs(26) * jvs(30)
+    jvs(32) = jvs(32) - jvs(15) * jvs(29) - jvs(27) * jvs(30)
+!   i = 10
+    jvs(33) = (jvs(33)) / jvs(10) 
+    jvs(34) = (jvs(34)) / jvs(13) 
+    jvs(35) = (jvs(35)) / jvs(19) 
+    a = 0.0; a = a  - jvs(11) * jvs(33) - jvs(20) * jvs(35)
+    jvs(36) = (jvs(36) + a) / jvs(25) 
+    a = 0.0; a = a  - jvs(12) * jvs(33) - jvs(14) * jvs(34) - jvs(21) * jvs(35) - jvs(26) * jvs(36)
+    jvs(37) = (jvs(37) + a) / jvs(31) 
+    jvs(38) = jvs(38) - jvs(15) * jvs(34) - jvs(22) * jvs(35) - jvs(27) * jvs(36) - jvs(32) * jvs(37)
+    RETURN                                                            
+                                                                      
+  END SUBROUTINE kppdecomp                                            
+ 
+SUBROUTINE chem_gasphase_integrate (time_step_len, conc, tempi, qvapi, fakti, photo, ierrf, xnacc, xnrej, istatus, l_debug, pe, &
+                     icntrl_i, rcntrl_i) 
+                                                                    
+  IMPLICIT NONE                                                     
+                                                                    
+  REAL(dp), INTENT(IN)                  :: time_step_len           
+  REAL(dp), DIMENSION(:, :), INTENT(INOUT) :: conc                    
+  REAL(dp), DIMENSION(:, :), INTENT(IN)   :: photo                   
+  REAL(dp), DIMENSION(:), INTENT(IN)     :: tempi                   
+  REAL(dp), DIMENSION(:), INTENT(IN)     :: qvapi                   
+  REAL(dp), DIMENSION(:), INTENT(IN)     :: fakti                   
+  INTEGER, INTENT(OUT), OPTIONAL        :: ierrf(:)               
+  INTEGER, INTENT(OUT), OPTIONAL        :: xnacc(:)               
+  INTEGER, INTENT(OUT), OPTIONAL        :: xnrej(:)               
+  INTEGER, INTENT(INOUT), OPTIONAL      :: istatus(:)             
+  INTEGER, INTENT(IN), OPTIONAL         :: pe                      
+  LOGICAL, INTENT(IN), OPTIONAL         :: l_debug                 
+  INTEGER, DIMENSION(nkppctrl), INTENT(IN), OPTIONAL  :: icntrl_i         
+  REAL(dp), DIMENSION(nkppctrl), INTENT(IN), OPTIONAL  :: rcntrl_i         
+                                                                    
+  INTEGER                                 :: k   ! loop variable     
+  REAL(dp)                               :: dt                      
+  INTEGER, DIMENSION(20)                :: istatus_u               
+  INTEGER                                :: ierr_u                  
+  INTEGER                                :: istatf                  
+  INTEGER                                :: vl_dim_lo               
+                                                                    
+                                                                    
+  IF (PRESENT (istatus)) istatus = 0                             
+  IF (PRESENT (icntrl_i)) icntrl  = icntrl_i                      
+  IF (PRESENT (rcntrl_i)) rcntrl  = rcntrl_i                      
+                                                                    
+  vl_glo = size(tempi, 1)                                           
+                                                                    
+  vl_dim_lo = vl_dim                                                
+  DO k=1, vl_glo, vl_dim_lo                                           
+    is = k                                                          
+    ie = min(k+ vl_dim_lo-1, vl_glo)                                 
+    vl = ie-is+ 1                                                    
+                                                                    
+    c(:) = conc(is, :)                                            
+                                                                    
+    temp = tempi(is)                                             
+                                                                    
+    qvap = qvapi(is)                                             
+                                                                    
+    fakt = fakti(is)                                             
+                                                                    
+    CALL initialize                                                 
+                                                                    
+    phot(:) = photo(is, :)                                            
+                                                                    
+    CALL update_rconst                                              
+                                                                    
+    dt = time_step_len                                              
+                                                                    
+    ! integrate from t=0 to t=dt                                    
+    CALL integrate(0._dp, dt, icntrl, rcntrl, istatus_u = istatus_u, ierr_u=ierr_u)
+                                                                    
+                                                                    
+   IF (PRESENT(l_debug) .AND. PRESENT(pe)) THEN                       
+      IF (l_debug) CALL error_output(conc(is, :), ierr_u, pe)          
+   ENDIF                                                              
+                                                                      
+    conc(is, :) = c(:)                                                
+                                                                    
+    ! RETURN diagnostic information                                 
+                                                                    
+    IF (PRESENT(ierrf))   ierrf(is) = ierr_u                      
+    IF (PRESENT(xnacc))   xnacc(is) = istatus_u(4)               
+    IF (PRESENT(xnrej))   xnrej(is) = istatus_u(5)               
+                                                                    
+    IF (PRESENT (istatus)) THEN                                   
+      istatus(1:8) = istatus(1:8) + istatus_u(1:8)                
+    ENDIF                                                          
+                                                                    
+  END DO                                                            
+ 
+                                                                    
+! Deallocate input arrays                                           
+                                                                    
+                                                                    
+  data_loaded = .FALSE.                                             
+                                                                    
+  RETURN                                                            
+END SUBROUTINE chem_gasphase_integrate                                        
+
+END MODULE chem_gasphase_mod
+ 
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_simplep/chem_gasphase_mod.kpp
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_simplep/chem_gasphase_mod.kpp	(revision 3298)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_simplep/chem_gasphase_mod.kpp	(revision 3298)
@@ -0,0 +1,36 @@
+//chem_gasphase_mod.kpp
+//
+//Former revisions
+//----------------
+// $Id: chem_gasphase_mod.kpp 2459 2017-09-13 14:10:33Z forkel $
+//
+// 'simple' gas phase chemistry with additional tracer named PM10
+//
+#include      simplep.spc
+#include      simplep.eqn
+#INTEGRATOR rosenbrock
+#LANGUAGE   Fortran90
+#HESSIAN    on
+#STOICMAT   on
+//
+// *******************************************************************************************
+// *** adapt the lines below occurding to the photolysis reactions of your mechanism         *
+// *** adapt the number of photolysis frequencies NPHO                                       *
+// *** adapt/extend the indices in the INTEGER, PARAMETER,PUBLIC statement below             *
+// *** adapt/extend PHOT_NAMES: Note that the order of PHOT_NAMES and the indices must match *
+// *******************************************************************************************
+//
+#INLINE F90_DATA
+  !   INLINE F90_DATA: Declaration of global variables for photolysis
+  !   REAL(kind=dp) :: phot(nphot) must eventually be moved to GLOBAL later for vector version
+  INTEGER, PARAMETER :: nphot = 2
+  !   phot Photolysis frequencies 
+  REAL(kind=dp) :: phot(nphot)
+
+  INTEGER, PARAMETER,PUBLIC :: j_no2 = 1
+  INTEGER, PARAMETER,PUBLIC :: j_o31d = 2
+
+  CHARACTER(LEN=15), PARAMETER, DIMENSION(NPHOT) :: phot_names =  (/ &
+     'J_NO2          ','J_O31D         '/)
+#ENDINLINE
+
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_simplep/simplep.eqn
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_simplep/simplep.eqn	(revision 3298)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_simplep/simplep.eqn	(revision 3298)
@@ -0,0 +1,19 @@
+{simplep.eqn
+Current revision
+----------------
+ 201711   Created simple.eqn with 6 equations forkel
+ 20180316  'simple' gas phase chemistry with additional tracer named PM10 forkel
+}
+#EQUATIONS
+
+{ home made very simple mechanism - please do not show to a chemist! }
+
+  { 1.}  NO2 + hv = NO + O3 :                   phot(j_no2)  ;
+  { 2.}  O3 + hv = 2OH + O2 :                   phot(j_o31d)  ;
+  { 3.}  NO + O3 = NO2 :                     arr2(1.8E-12_dp, 1370.0_dp, temp) ;
+  { 4.}  RH + OH = RO2 + H2O :               arr2(2.E-11_dp, 500.0_dp, temp) ;
+  { 5.}  RO2 + NO = NO2 + RCHO + HO2 :       arr2(4.2E-12_dp, -180.0_dp, temp);
+  { 6.}  HO2 + NO = NO2 + OH :               arr2(3.7E-12_dp, -240.0_dp, temp) ;
+  { 7.}  NO2 + OH = HNO3     :               arr2(1.15E-11_dp, 0.0_dp, temp) ;
+  { 8.}  PM10 = PM10 :                          1.0_dp  ;
+
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_simplep/simplep.spc
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_simplep/simplep.spc	(revision 3298)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_simplep/simplep.spc	(revision 3298)
@@ -0,0 +1,43 @@
+{simple.spc
+Former revisions
+----------------
+ $Id: smog.spc 2459 2017-09-13 14:10:33Z forkel $
+}
+#include atoms
+
+ #DEFVAR  
+    O       = O ;      		{oxygen atomic ground state (3P)}
+    O3		= 3O ;          {ozone}  
+    NO		= N + O ;       {nitric oxide}  
+    NO2		= N + 2O ;      {nitrogen dioxide} 
+    NO3		= N + 3O ;      {nitrogen trioxide} 
+    N2O5	= 2N + 5O ;     {dinitrogen pentoxide}           
+    HNO3	= H + N + 3O ;  { nitric acid }
+    HNO4	= H + N + 4O ;  {HO2NO2 pernitric acid}
+    H           = H ;           {hydrogen atomic ground state (2S)}
+    OH		= O + H ;       {hydroxyl radical}  
+    HO2		= H + 2O ;      {perhydroxyl radical}                     
+    H2O2	= 2H + 2O ;     {hydrogen peroxide} 
+    CH3     = C + 3H ;      {methyl radical}
+    CH3O    = C + 3H + O ;  {methoxy radical}
+    CH3O2   = C + 3H + 2O ; {methylperoxy radical}
+    CH3OOH  = C + 4H + 2O ; {CH4O2      methylperoxy alcohol}
+    HCO     = H + C + O ;   {CHO  formyl radical}
+    CH2O    = C + 2H + O ;  {formalydehyde}
+    CO      = C + O ;       {carbon monoxide}   
+
+    PM10    = ignore ;      {passive tracer}   
+    RH      = ignore ;
+    RO2     = ignore ;
+    RCHO    = ignore ;
+    RCOO2   = ignore ;
+    RCOO2NO2= ignore ;
+
+#DEFFIX
+    H2O		= H + 2O ;      {water}
+    H2		= 2H ;          {molecular hydrogen}
+    O2      = 2O ;          {molecular oxygen}              
+    N2      = 2N ;          {molecular nitrogen}              
+    CH4		= C + 4H ;      {methane} 
+    CO2     = C + 2O ;      {carbon dioxide}
+
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_smog/chem_gasphase_mod.f90
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_smog/chem_gasphase_mod.f90	(revision 3298)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_smog/chem_gasphase_mod.f90	(revision 3298)
@@ -0,0 +1,2645 @@
+MODULE chem_gasphase_mod
+ 
+!   Mechanism: smog
+!
+!------------------------------------------------------------------------------!
+!
+! ******Module chem_gasphase_mod is automatically generated by kpp4palm ******
+!
+!   *********Please do NOT change this Code,it will be ovewritten *********
+!
+!------------------------------------------------------------------------------!
+! This file was created by KPP (http://people.cs.vt.edu/asandu/Software/Kpp/)
+! and kpp4palm (created by Klaus Ketelsen). kpp4palm is an adapted version 
+! of KP4 (JÃ¶ckel,P.,Kerkweg,A.,Pozzer,A.,Sander,R.,Tost,H.,Riede,
+! H.,Baumgaertner,A.,Gromov,S.,and Kern,B.,2010: Development cycle 2 of
+! the Modular Earth Submodel System (MESSy2),Geosci. Model Dev.,3,717-752,
+! https://doi.org/10.5194/gmd-3-717-2010). KP4 is part of the Modular Earth 
+! Submodel System (MESSy),which is is available under the  GNU General Public 
+! License (GPL).
+!
+! KPP is free software; you can redistribute it and/or modify it under the terms 
+! of the General Public Licence as published by the Free Software Foundation; 
+! either version 2 of the License,or (at your option) any later version. 
+! KPP is distributed in the hope that it will be useful,but WITHOUT ANY WARRANTY; 
+! without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 
+! PURPOSE. See the GNU General Public Licence for more details. 
+!
+!------------------------------------------------------------------------------!
+! This file is part of the PALM model system.
+!
+! PALM is free software: you can redistribute it and/or modify it under the
+! terms of the GNU General Public License as published by the Free Software
+! Foundation,either version 3 of the License,or (at your option) any later
+! version.
+!
+! PALM is distributed in the hope that it will be useful,but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not,see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2018 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! ------------------
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id: module_header 2460 2017-09-13 14:47:48Z forkel $
+! forkel June 2018: qvap,fakt added
+! forkel June 2018: reset case in  Initialize,Integrate,Update_rconst
+! 
+! 
+! 2460 2017-09-13 14:47:48Z forkel
+!
+! forkel Sept. 2017: Variables for photolyis added
+!
+!
+! Nov. 2016: Intial version (Klaus Ketelsen)
+!
+!------------------------------------------------------------------------------!
+!
+
+
+! Set kpp Double Precision to PALM Default Precision
+
+  USE kinds,           ONLY: dp=>wp
+
+  USE pegrid,          ONLY: myid, threads_per_task
+
+  IMPLICIT        NONE
+  PRIVATE
+  !SAVE  ! note: occurs again in automatically generated code ...
+
+!  PUBLIC :: IERR_NAMES
+ 
+! PUBLIC :: SPC_NAMES,EQN_NAMES,EQN_TAGS,REQ_HET,REQ_AEROSOL,REQ_PHOTRAT &
+!         ,REQ_MCFCT,IP_MAX,jname
+
+  PUBLIC :: eqn_names, phot_names, spc_names
+  PUBLIC :: nmaxfixsteps
+  PUBLIC :: atol, rtol
+  PUBLIC :: nspec, nreact
+  PUBLIC :: temp
+  PUBLIC :: qvap
+  PUBLIC :: fakt
+  PUBLIC :: phot 
+  PUBLIC :: rconst
+  PUBLIC :: nvar
+  PUBLIC :: nphot
+  PUBLIC :: vl_dim                     ! PUBLIC to ebable other MODULEs to distiguish between scalar and vec
+ 
+  PUBLIC :: initialize, integrate, update_rconst
+  PUBLIC :: chem_gasphase_integrate
+  PUBLIC :: initialize_kpp_ctrl
+
+! END OF MODULE HEADER TEMPLATE
+                                                                 
+! Variables used for vector mode                                 
+                                                                 
+  LOGICAL, PARAMETER          :: l_vector = .FALSE.            
+  INTEGER, PARAMETER          :: i_lu_di = 2
+  INTEGER, PARAMETER          :: vl_dim = 1
+  INTEGER                     :: vl                              
+                                                                 
+  INTEGER                     :: vl_glo                          
+  INTEGER                     :: is, ie                           
+                                                                 
+                                                                 
+  INTEGER, DIMENSION(vl_dim)  :: kacc, krej                       
+  INTEGER, DIMENSION(vl_dim)  :: ierrv                           
+  LOGICAL                     :: data_loaded = .FALSE.             
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Parameter Module File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Parameters.f90
+! Time                 : Tue Sep 25 18:35:20 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! NSPEC - Number of chemical species
+  INTEGER, PARAMETER :: nspec = 16 
+! NVAR - Number of Variable species
+  INTEGER, PARAMETER :: nvar = 13 
+! NVARACT - Number of Active species
+  INTEGER, PARAMETER :: nvaract = 11 
+! NFIX - Number of Fixed species
+  INTEGER, PARAMETER :: nfix = 3 
+! NREACT - Number of reactions
+  INTEGER, PARAMETER :: nreact = 12 
+! NVARST - Starting of variables in conc. vect.
+  INTEGER, PARAMETER :: nvarst = 1 
+! NFIXST - Starting of fixed in conc. vect.
+  INTEGER, PARAMETER :: nfixst = 14 
+! NONZERO - Number of nonzero entries in Jacobian
+  INTEGER, PARAMETER :: nonzero = 55 
+! LU_NONZERO - Number of nonzero entries in LU factoriz. of Jacobian
+  INTEGER, PARAMETER :: lu_nonzero = 61 
+! CNVAR - (NVAR+1) Number of elements in compressed row format
+  INTEGER, PARAMETER :: cnvar = 14 
+! CNEQN - (NREACT+1) Number stoicm elements in compressed col format
+  INTEGER, PARAMETER :: cneqn = 13 
+! NHESS - Length of Sparse Hessian
+  INTEGER, PARAMETER :: nhess = 28 
+! NMASS - Number of atoms to check mass balance
+  INTEGER, PARAMETER :: nmass = 1 
+
+! Index declaration for variable species in C and VAR
+!   VAR(ind_spc) = C(ind_spc)
+
+  INTEGER, PARAMETER, PUBLIC :: ind_hno3 = 1 
+  INTEGER, PARAMETER, PUBLIC :: ind_co = 2 
+  INTEGER, PARAMETER, PUBLIC :: ind_o = 3 
+  INTEGER, PARAMETER, PUBLIC :: ind_rh = 4 
+  INTEGER, PARAMETER, PUBLIC :: ind_rcoo2no2 = 5 
+  INTEGER, PARAMETER, PUBLIC :: ind_o3 = 6 
+  INTEGER, PARAMETER, PUBLIC :: ind_ho2 = 7 
+  INTEGER, PARAMETER, PUBLIC :: ind_rcoo2 = 8 
+  INTEGER, PARAMETER, PUBLIC :: ind_rcho = 9 
+  INTEGER, PARAMETER, PUBLIC :: ind_ro2 = 10 
+  INTEGER, PARAMETER, PUBLIC :: ind_oh = 11 
+  INTEGER, PARAMETER, PUBLIC :: ind_no = 12 
+  INTEGER, PARAMETER, PUBLIC :: ind_no2 = 13 
+
+! Index declaration for fixed species in C
+!   C(ind_spc)
+
+  INTEGER, PARAMETER, PUBLIC :: ind_h2o = 14 
+  INTEGER, PARAMETER, PUBLIC :: ind_o2 = 15 
+  INTEGER, PARAMETER, PUBLIC :: ind_co2 = 16 
+
+! Index declaration for fixed species in FIX
+!    FIX(indf_spc) = C(ind_spc) = C(NVAR+indf_spc)
+
+  INTEGER, PARAMETER :: indf_h2o = 1 
+  INTEGER, PARAMETER :: indf_o2 = 2 
+  INTEGER, PARAMETER :: indf_co2 = 3 
+
+! NJVRP - Length of sparse Jacobian JVRP
+  INTEGER, PARAMETER :: njvrp = 20 
+
+! NSTOICM - Length of Sparse Stoichiometric Matrix
+  INTEGER, PARAMETER :: nstoicm = 40 
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Global Data Module File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Global.f90
+! Time                 : Tue Sep 25 18:35:20 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! Declaration of global variables
+
+! C - Concentration of all species
+  REAL(kind=dp):: c(nspec)
+! VAR - Concentrations of variable species (global)
+  REAL(kind=dp):: var(nvar)
+! FIX - Concentrations of fixed species (global)
+  REAL(kind=dp):: fix(nfix)
+! VAR,FIX are chunks of array C
+      EQUIVALENCE( c(1), var(1))
+      EQUIVALENCE( c(14), fix(1))
+! RCONST - Rate constants (global)
+  REAL(kind=dp):: rconst(nreact)
+! TIME - Current integration time
+  REAL(kind=dp):: time
+! TEMP - Temperature
+  REAL(kind=dp):: temp
+! TSTART - Integration start time
+  REAL(kind=dp):: tstart
+! ATOL - Absolute tolerance
+  REAL(kind=dp):: atol(nvar)
+! RTOL - Relative tolerance
+  REAL(kind=dp):: rtol(nvar)
+! STEPMIN - Lower bound for integration step
+  REAL(kind=dp):: stepmin
+! CFACTOR - Conversion factor for concentration units
+  REAL(kind=dp):: cfactor
+
+! INLINED global variable declarations
+
+! QVAP - Water vapor
+  REAL(kind=dp):: qvap
+! FAKT - Conversion factor
+  REAL(kind=dp):: fakt
+
+
+! INLINED global variable declarations
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Sparse Jacobian Data Structures File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_JacobianSP.f90
+! Time                 : Tue Sep 25 18:35:20 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! Sparse Jacobian Data
+
+
+  INTEGER, PARAMETER, DIMENSION(61):: lu_irow =  (/ &
+       1, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 5, &
+       6, 6, 6, 6, 7, 7, 7, 7, 8, 8, 8, 8, &
+       8, 8, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, &
+      10, 11, 11, 11, 11, 11, 11, 11, 12, 12, 12, 12, &
+      12, 12, 12, 12, 13, 13, 13, 13, 13, 13, 13, 13, &
+      13 /) 
+
+  INTEGER, PARAMETER, DIMENSION(61):: lu_icol =  (/ &
+       1, 11, 13, 2, 9, 3, 13, 4, 11, 5, 8, 13, &
+       3, 6, 12, 13, 7, 9, 10, 12, 5, 8, 9, 11, &
+      12, 13, 9, 10, 11, 12, 4, 8, 9, 10, 11, 12, &
+      13, 4, 7, 9, 10, 11, 12, 13, 6, 7, 8, 9, &
+      10, 11, 12, 13, 5, 6, 7, 8, 9, 10, 11, 12, &
+      13 /) 
+
+  INTEGER, PARAMETER, DIMENSION(14):: lu_crow =  (/ &
+       1, 4, 6, 8, 10, 13, 17, 21, 27, 31, 38, 45, &
+      53, 62 /) 
+
+  INTEGER, PARAMETER, DIMENSION(14):: lu_diag =  (/ &
+       1, 4, 6, 8, 10, 14, 17, 22, 27, 34, 42, 51, &
+      61, 62 /) 
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Utility Data Module File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Monitor.f90
+! Time                 : Tue Sep 25 18:35:20 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+  CHARACTER(len=15), PARAMETER, DIMENSION(16):: spc_names =  (/ &
+     'HNO3           ','CO             ','O              ',&
+     'RH             ','RCOO2NO2       ','O3             ',&
+     'HO2            ','RCOO2          ','RCHO           ',&
+     'RO2            ','OH             ','NO             ',&
+     'NO2            ','H2O            ','O2             ',&
+     'CO2            ' /)
+
+  CHARACTER(len=100), PARAMETER, DIMENSION(12):: eqn_names =  (/ &
+     '        NO2 --> O + NO                                                                              ',&
+     '     O + O2 --> O3                                                                                  ',&
+     '    O3 + NO --> NO2 + O2                                                                            ',&
+     '    RH + OH --> RO2 + H2O                                                                           ',&
+     '  RCHO + OH --> RCOO2 + H2O                                                                         ',&
+     '       RCHO --> CO + HO2 + RO2                                                                      ',&
+     '   HO2 + NO --> OH + NO2                                                                            ',&
+     '   RO2 + NO --> HO2 + RCHO + NO2                                                                    ',&
+     ' RCOO2 + NO --> RO2 + NO2 + CO2                                                                     ',&
+     '   OH + NO2 --> HNO3                                                                                ',&
+     'RCOO2 + NO2 --> RCOO2NO2                                                                            ',&
+     '   RCOO2NO2 --> RCOO2 + NO2                                                                         ' /)
+
+! INLINED global variables
+
+  !   inline f90_data: declaration of global variables for photolysis
+  !   REAL(kind=dp):: phot(nphot)must eventually be moved to global later for 
+  INTEGER, PARAMETER :: nphot = 2
+  !   phot photolysis frequencies 
+  REAL(kind=dp):: phot(nphot)
+
+  INTEGER, PARAMETER, PUBLIC :: j_no2 = 1
+  INTEGER, PARAMETER, PUBLIC :: j_rcho = 2
+
+  CHARACTER(len=15), PARAMETER, DIMENSION(nphot):: phot_names =   (/ &
+     'J_NO2          ','J_RCHO         '/)
+
+! End INLINED global variables
+
+
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+! Automatic generated PUBLIC Statements for ip_ and ihs_ variables 
+ 
+ 
+!  variable definations from  individual module headers 
+ 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Initialization File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Initialize.f90
+! Time                 : Tue Sep 25 18:35:20 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Numerical Integrator (Time-Stepping) File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Integrator.f90
+! Time                 : Tue Sep 25 18:35:20 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! INTEGRATE - Integrator routine
+!   Arguments :
+!      TIN       - Start Time for Integration
+!      TOUT      - End Time for Integration
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
+!  Rosenbrock - Implementation of several Rosenbrock methods:             !
+!               *Ros2                                                    !
+!               *Ros3                                                    !
+!               *Ros4                                                    !
+!               *Rodas3                                                  !
+!               *Rodas4                                                  !
+!  By default the code employs the KPP sparse linear algebra routines     !
+!  Compile with -DFULL_ALGEBRA to use full linear algebra (LAPACK)        !
+!                                                                         !
+!    (C)  Adrian Sandu,August 2004                                       !
+!    Virginia Polytechnic Institute and State University                  !
+!    Contact: sandu@cs.vt.edu                                             !
+!    Revised by Philipp Miehe and Adrian Sandu,May 2006                  !                               !
+!    This implementation is part of KPP - the Kinetic PreProcessor        !
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
+
+
+  SAVE
+  
+!~~~>  statistics on the work performed by the rosenbrock method
+  INTEGER, PARAMETER :: nfun=1, njac=2, nstp=3, nacc=4, &
+                        nrej=5, ndec=6, nsol=7, nsng=8, &
+                        ntexit=1, nhexit=2, nhnew = 3
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Linear Algebra Data and Routines File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_LinearAlgebra.f90
+! Time                 : Tue Sep 25 18:35:20 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! The ODE Jacobian of Chemical Model File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Jacobian.f90
+! Time                 : Tue Sep 25 18:35:20 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! The ODE Function of Chemical Model File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Function.f90
+! Time                 : Tue Sep 25 18:35:20 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+! A - Rate for each equation
+  REAL(kind=dp):: a(nreact)
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! The Reaction Rates File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Rates.f90
+! Time                 : Tue Sep 25 18:35:20 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! Auxiliary Routines File
+! 
+! Generated by KPP-2.2.3 symbolic chemistry Kinetics PreProcessor
+!       (http://www.cs.vt.edu/~asandu/Software/KPP)
+! KPP is distributed under GPL,the general public licence
+!       (http://www.gnu.org/copyleft/gpl.html)
+! (C) 1995-1997,V. Damian & A. Sandu,CGRER,Univ. Iowa
+! (C) 1997-2005,A. Sandu,Michigan Tech,Virginia Tech
+!     With important contributions from:
+!        M. Damian,Villanova University,USA
+!        R. Sander,Max-Planck Institute for Chemistry,Mainz,Germany
+! 
+! File                 : chem_gasphase_mod_Util.f90
+! Time                 : Tue Sep 25 18:35:20 2018
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20180925/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+  ! header MODULE initialize_kpp_ctrl_template
+
+  ! notes:
+  ! - l_vector is automatically defined by kp4
+  ! - vl_dim is automatically defined by kp4
+  ! - i_lu_di is automatically defined by kp4
+  ! - wanted is automatically defined by xmecca
+  ! - icntrl rcntrl are automatically defined by kpp
+  ! - "USE messy_main_tools" is in MODULE_header of messy_mecca_kpp.f90
+  ! - SAVE will be automatically added by kp4
+
+  !SAVE
+
+  ! for fixed time step control
+  ! ... max. number of fixed time steps (sum must be 1)
+  INTEGER, PARAMETER         :: nmaxfixsteps = 50
+  ! ... switch for fixed time stepping
+  LOGICAL, PUBLIC            :: l_fixed_step = .FALSE.
+  INTEGER, PUBLIC            :: nfsteps = 1
+  ! ... number of kpp control PARAMETERs
+  INTEGER, PARAMETER, PUBLIC :: nkppctrl = 20
+  !
+  INTEGER, DIMENSION(nkppctrl), PUBLIC     :: icntrl = 0
+  REAL(dp), DIMENSION(nkppctrl), PUBLIC     :: rcntrl = 0.0_dp
+  REAL(dp), DIMENSION(nmaxfixsteps), PUBLIC :: t_steps = 0.0_dp
+
+  ! END header MODULE initialize_kpp_ctrl_template
+
+ 
+! Interface Block 
+ 
+  INTERFACE            initialize
+    MODULE PROCEDURE   initialize
+  END INTERFACE        initialize
+ 
+  INTERFACE            integrate
+    MODULE PROCEDURE   integrate
+  END INTERFACE        integrate
+ 
+  INTERFACE            fun
+    MODULE PROCEDURE   fun
+  END INTERFACE        fun
+ 
+  INTERFACE            kppsolve
+    MODULE PROCEDURE   kppsolve
+  END INTERFACE        kppsolve
+ 
+  INTERFACE            jac_sp
+    MODULE PROCEDURE   jac_sp
+  END INTERFACE        jac_sp
+ 
+  INTERFACE            k_arr
+    MODULE PROCEDURE   k_arr
+  END INTERFACE        k_arr
+ 
+  INTERFACE            update_rconst
+    MODULE PROCEDURE   update_rconst
+  END INTERFACE        update_rconst
+ 
+  INTERFACE            arr2
+    MODULE PROCEDURE   arr2
+  END INTERFACE        arr2
+ 
+  INTERFACE            initialize_kpp_ctrl
+    MODULE PROCEDURE   initialize_kpp_ctrl
+  END INTERFACE        initialize_kpp_ctrl
+ 
+  INTERFACE            error_output
+    MODULE PROCEDURE   error_output
+  END INTERFACE        error_output
+ 
+  INTERFACE            wscal
+    MODULE PROCEDURE   wscal
+  END INTERFACE        wscal
+ 
+!INTERFACE not working  INTERFACE            waxpy
+!INTERFACE not working    MODULE PROCEDURE   waxpy
+!INTERFACE not working  END INTERFACE        waxpy
+ 
+  INTERFACE            rosenbrock
+    MODULE PROCEDURE   rosenbrock
+  END INTERFACE        rosenbrock
+ 
+  INTERFACE            funtemplate
+    MODULE PROCEDURE   funtemplate
+  END INTERFACE        funtemplate
+ 
+  INTERFACE            jactemplate
+    MODULE PROCEDURE   jactemplate
+  END INTERFACE        jactemplate
+ 
+  INTERFACE            kppdecomp
+    MODULE PROCEDURE   kppdecomp
+  END INTERFACE        kppdecomp
+ 
+  INTERFACE            chem_gasphase_integrate
+    MODULE PROCEDURE   chem_gasphase_integrate
+  END INTERFACE        chem_gasphase_integrate
+ 
+ 
+ CONTAINS
+ 
+SUBROUTINE initialize()
+
+
+  INTEGER         :: j, k
+
+  INTEGER :: i
+  REAL(kind=dp):: x
+  k = is
+  cfactor = 1.000000e+00_dp
+
+  x = (0.) * cfactor
+  DO i = 1 , nvar
+  ENDDO
+
+  x = (0.) * cfactor
+  DO i = 1 , nfix
+    fix(i) = x
+  ENDDO
+
+! constant rate coefficients
+! END constant rate coefficients
+
+! INLINED initializations
+
+  fix(indf_h2o) = qvap
+  fix(indf_o2) = 0.2e+6_dp  *  fakt
+  fix(indf_co2) = 400.0_dp  *  fakt
+
+! End INLINED initializations
+
+      
+END SUBROUTINE initialize
+ 
+SUBROUTINE integrate( tin, tout, &
+  icntrl_u, rcntrl_u, istatus_u, rstatus_u, ierr_u)
+
+
+   REAL(kind=dp), INTENT(IN):: tin  ! start time
+   REAL(kind=dp), INTENT(IN):: tout ! END time
+   ! OPTIONAL input PARAMETERs and statistics
+   INTEGER,      INTENT(IN), OPTIONAL :: icntrl_u(20)
+   REAL(kind=dp), INTENT(IN), OPTIONAL :: rcntrl_u(20)
+   INTEGER,      INTENT(OUT), OPTIONAL :: istatus_u(20)
+   REAL(kind=dp), INTENT(OUT), OPTIONAL :: rstatus_u(20)
+   INTEGER,      INTENT(OUT), OPTIONAL :: ierr_u
+
+   REAL(kind=dp):: rcntrl(20), rstatus(20)
+   INTEGER       :: icntrl(20), istatus(20), ierr
+
+   INTEGER, SAVE :: ntotal = 0
+
+   icntrl(:) = 0
+   rcntrl(:) = 0.0_dp
+   istatus(:) = 0
+   rstatus(:) = 0.0_dp
+
+    !~~~> fine-tune the integrator:
+   icntrl(1) = 0      ! 0 - non- autonomous, 1 - autonomous
+   icntrl(2) = 0      ! 0 - vector tolerances, 1 - scalars
+
+   ! IF OPTIONAL PARAMETERs are given, and IF they are >0, 
+   ! THEN they overwrite default settings. 
+   IF (PRESENT(icntrl_u))THEN
+     WHERE(icntrl_u(:)> 0)icntrl(:) = icntrl_u(:)
+   ENDIF
+   IF (PRESENT(rcntrl_u))THEN
+     WHERE(rcntrl_u(:)> 0)rcntrl(:) = rcntrl_u(:)
+   ENDIF
+
+
+   CALL rosenbrock(nvar, var, tin, tout,  &
+         atol, rtol,               &
+         rcntrl, icntrl, rstatus, istatus, ierr)
+
+   !~~~> debug option: show no of steps
+   ! ntotal = ntotal + istatus(nstp)
+   ! PRINT*,'NSTEPS=',ISTATUS(Nstp),' (',Ntotal,')','  O3=',VAR(ind_O3)
+
+   stepmin = rstatus(nhexit)
+   ! IF OPTIONAL PARAMETERs are given for output they 
+   ! are updated with the RETURN information
+   IF (PRESENT(istatus_u))istatus_u(:) = istatus(:)
+   IF (PRESENT(rstatus_u))rstatus_u(:) = rstatus(:)
+   IF (PRESENT(ierr_u))  ierr_u       = ierr
+
+END SUBROUTINE integrate
+ 
+SUBROUTINE fun(v, f, rct, vdot)
+
+! V - Concentrations of variable species (local)
+  REAL(kind=dp):: v(nvar)
+! F - Concentrations of fixed species (local)
+  REAL(kind=dp):: f(nfix)
+! RCT - Rate constants (local)
+  REAL(kind=dp):: rct(nreact)
+! Vdot - Time derivative of variable species concentrations
+  REAL(kind=dp):: vdot(nvar)
+
+
+! Computation of equation rates
+  a(1) = rct(1) * v(13)
+  a(2) = rct(2) * v(3) * f(2)
+  a(3) = rct(3) * v(6) * v(12)
+  a(4) = rct(4) * v(4) * v(11)
+  a(5) = rct(5) * v(9) * v(11)
+  a(6) = rct(6) * v(9)
+  a(7) = rct(7) * v(7) * v(12)
+  a(8) = rct(8) * v(10) * v(12)
+  a(9) = rct(9) * v(8) * v(12)
+  a(10) = rct(10) * v(11) * v(13)
+  a(11) = rct(11) * v(8) * v(13)
+  a(12) = rct(12) * v(5)
+
+! Aggregate function
+  vdot(1) = a(10)
+  vdot(2) = a(6)
+  vdot(3) = a(1) - a(2)
+  vdot(4) = - a(4)
+  vdot(5) = a(11) - a(12)
+  vdot(6) = a(2) - a(3)
+  vdot(7) = a(6) - a(7) + a(8)
+  vdot(8) = a(5) - a(9) - a(11) + a(12)
+  vdot(9) = - a(5) - a(6) + a(8)
+  vdot(10) = a(4) + a(6) - a(8) + a(9)
+  vdot(11) = - a(4) - a(5) + a(7) - a(10)
+  vdot(12) = a(1) - a(3) - a(7) - a(8) - a(9)
+  vdot(13) = - a(1) + a(3) + a(7) + a(8) + a(9) - a(10) - a(11) + a(12)
+      
+END SUBROUTINE fun
+ 
+SUBROUTINE kppsolve(jvs, x)
+
+! JVS - sparse Jacobian of variables
+  REAL(kind=dp):: jvs(lu_nonzero)
+! X - Vector for variables
+  REAL(kind=dp):: x(nvar)
+
+  x(6) = x(6) - jvs(13) * x(3)
+  x(8) = x(8) - jvs(21) * x(5)
+  x(10) = x(10) - jvs(31) * x(4) - jvs(32) * x(8) - jvs(33) * x(9)
+  x(11) = x(11) - jvs(38) * x(4) - jvs(39) * x(7) - jvs(40) * x(9) - jvs(41) * x(10)
+  x(12) = x(12) - jvs(45) * x(6) - jvs(46) * x(7) - jvs(47) * x(8) - jvs(48) * x(9) - jvs(49) * x(10) - jvs(50) * x(11)
+  x(13) = x(13) - jvs(53) * x(5) - jvs(54) * x(6) - jvs(55) * x(7) - jvs(56) * x(8) - jvs(57) * x(9) - jvs(58) * x(10) - jvs(59) &
+                     * x(11) - jvs(60)&
+            &* x(12)
+  x(13) = x(13) / jvs(61)
+  x(12) = (x(12) - jvs(52) * x(13)) /(jvs(51))
+  x(11) = (x(11) - jvs(43) * x(12) - jvs(44) * x(13)) /(jvs(42))
+  x(10) = (x(10) - jvs(35) * x(11) - jvs(36) * x(12) - jvs(37) * x(13)) /(jvs(34))
+  x(9) = (x(9) - jvs(28) * x(10) - jvs(29) * x(11) - jvs(30) * x(12)) /(jvs(27))
+  x(8) = (x(8) - jvs(23) * x(9) - jvs(24) * x(11) - jvs(25) * x(12) - jvs(26) * x(13)) /(jvs(22))
+  x(7) = (x(7) - jvs(18) * x(9) - jvs(19) * x(10) - jvs(20) * x(12)) /(jvs(17))
+  x(6) = (x(6) - jvs(15) * x(12) - jvs(16) * x(13)) /(jvs(14))
+  x(5) = (x(5) - jvs(11) * x(8) - jvs(12) * x(13)) /(jvs(10))
+  x(4) = (x(4) - jvs(9) * x(11)) /(jvs(8))
+  x(3) = (x(3) - jvs(7) * x(13)) /(jvs(6))
+  x(2) = (x(2) - jvs(5) * x(9)) /(jvs(4))
+  x(1) = (x(1) - jvs(2) * x(11) - jvs(3) * x(13)) /(jvs(1))
+      
+END SUBROUTINE kppsolve
+ 
+SUBROUTINE jac_sp(v, f, rct, jvs)
+
+! V - Concentrations of variable species (local)
+  REAL(kind=dp):: v(nvar)
+! F - Concentrations of fixed species (local)
+  REAL(kind=dp):: f(nfix)
+! RCT - Rate constants (local)
+  REAL(kind=dp):: rct(nreact)
+! JVS - sparse Jacobian of variables
+  REAL(kind=dp):: jvs(lu_nonzero)
+
+
+! Local variables
+! B - Temporary array
+  REAL(kind=dp):: b(21)
+
+! B(1) = dA(1)/dV(13)
+  b(1) = rct(1)
+! B(2) = dA(2)/dV(3)
+  b(2) = rct(2) * f(2)
+! B(4) = dA(3)/dV(6)
+  b(4) = rct(3) * v(12)
+! B(5) = dA(3)/dV(12)
+  b(5) = rct(3) * v(6)
+! B(6) = dA(4)/dV(4)
+  b(6) = rct(4) * v(11)
+! B(7) = dA(4)/dV(11)
+  b(7) = rct(4) * v(4)
+! B(8) = dA(5)/dV(9)
+  b(8) = rct(5) * v(11)
+! B(9) = dA(5)/dV(11)
+  b(9) = rct(5) * v(9)
+! B(10) = dA(6)/dV(9)
+  b(10) = rct(6)
+! B(11) = dA(7)/dV(7)
+  b(11) = rct(7) * v(12)
+! B(12) = dA(7)/dV(12)
+  b(12) = rct(7) * v(7)
+! B(13) = dA(8)/dV(10)
+  b(13) = rct(8) * v(12)
+! B(14) = dA(8)/dV(12)
+  b(14) = rct(8) * v(10)
+! B(15) = dA(9)/dV(8)
+  b(15) = rct(9) * v(12)
+! B(16) = dA(9)/dV(12)
+  b(16) = rct(9) * v(8)
+! B(17) = dA(10)/dV(11)
+  b(17) = rct(10) * v(13)
+! B(18) = dA(10)/dV(13)
+  b(18) = rct(10) * v(11)
+! B(19) = dA(11)/dV(8)
+  b(19) = rct(11) * v(13)
+! B(20) = dA(11)/dV(13)
+  b(20) = rct(11) * v(8)
+! B(21) = dA(12)/dV(5)
+  b(21) = rct(12)
+
+! Construct the Jacobian terms from B's
+! JVS(1) = Jac_FULL(1,1)
+  jvs(1) = 0
+! JVS(2) = Jac_FULL(1,11)
+  jvs(2) = b(17)
+! JVS(3) = Jac_FULL(1,13)
+  jvs(3) = b(18)
+! JVS(4) = Jac_FULL(2,2)
+  jvs(4) = 0
+! JVS(5) = Jac_FULL(2,9)
+  jvs(5) = b(10)
+! JVS(6) = Jac_FULL(3,3)
+  jvs(6) = - b(2)
+! JVS(7) = Jac_FULL(3,13)
+  jvs(7) = b(1)
+! JVS(8) = Jac_FULL(4,4)
+  jvs(8) = - b(6)
+! JVS(9) = Jac_FULL(4,11)
+  jvs(9) = - b(7)
+! JVS(10) = Jac_FULL(5,5)
+  jvs(10) = - b(21)
+! JVS(11) = Jac_FULL(5,8)
+  jvs(11) = b(19)
+! JVS(12) = Jac_FULL(5,13)
+  jvs(12) = b(20)
+! JVS(13) = Jac_FULL(6,3)
+  jvs(13) = b(2)
+! JVS(14) = Jac_FULL(6,6)
+  jvs(14) = - b(4)
+! JVS(15) = Jac_FULL(6,12)
+  jvs(15) = - b(5)
+! JVS(16) = Jac_FULL(6,13)
+  jvs(16) = 0
+! JVS(17) = Jac_FULL(7,7)
+  jvs(17) = - b(11)
+! JVS(18) = Jac_FULL(7,9)
+  jvs(18) = b(10)
+! JVS(19) = Jac_FULL(7,10)
+  jvs(19) = b(13)
+! JVS(20) = Jac_FULL(7,12)
+  jvs(20) = - b(12) + b(14)
+! JVS(21) = Jac_FULL(8,5)
+  jvs(21) = b(21)
+! JVS(22) = Jac_FULL(8,8)
+  jvs(22) = - b(15) - b(19)
+! JVS(23) = Jac_FULL(8,9)
+  jvs(23) = b(8)
+! JVS(24) = Jac_FULL(8,11)
+  jvs(24) = b(9)
+! JVS(25) = Jac_FULL(8,12)
+  jvs(25) = - b(16)
+! JVS(26) = Jac_FULL(8,13)
+  jvs(26) = - b(20)
+! JVS(27) = Jac_FULL(9,9)
+  jvs(27) = - b(8) - b(10)
+! JVS(28) = Jac_FULL(9,10)
+  jvs(28) = b(13)
+! JVS(29) = Jac_FULL(9,11)
+  jvs(29) = - b(9)
+! JVS(30) = Jac_FULL(9,12)
+  jvs(30) = b(14)
+! JVS(31) = Jac_FULL(10,4)
+  jvs(31) = b(6)
+! JVS(32) = Jac_FULL(10,8)
+  jvs(32) = b(15)
+! JVS(33) = Jac_FULL(10,9)
+  jvs(33) = b(10)
+! JVS(34) = Jac_FULL(10,10)
+  jvs(34) = - b(13)
+! JVS(35) = Jac_FULL(10,11)
+  jvs(35) = b(7)
+! JVS(36) = Jac_FULL(10,12)
+  jvs(36) = - b(14) + b(16)
+! JVS(37) = Jac_FULL(10,13)
+  jvs(37) = 0
+! JVS(38) = Jac_FULL(11,4)
+  jvs(38) = - b(6)
+! JVS(39) = Jac_FULL(11,7)
+  jvs(39) = b(11)
+! JVS(40) = Jac_FULL(11,9)
+  jvs(40) = - b(8)
+! JVS(41) = Jac_FULL(11,10)
+  jvs(41) = 0
+! JVS(42) = Jac_FULL(11,11)
+  jvs(42) = - b(7) - b(9) - b(17)
+! JVS(43) = Jac_FULL(11,12)
+  jvs(43) = b(12)
+! JVS(44) = Jac_FULL(11,13)
+  jvs(44) = - b(18)
+! JVS(45) = Jac_FULL(12,6)
+  jvs(45) = - b(4)
+! JVS(46) = Jac_FULL(12,7)
+  jvs(46) = - b(11)
+! JVS(47) = Jac_FULL(12,8)
+  jvs(47) = - b(15)
+! JVS(48) = Jac_FULL(12,9)
+  jvs(48) = 0
+! JVS(49) = Jac_FULL(12,10)
+  jvs(49) = - b(13)
+! JVS(50) = Jac_FULL(12,11)
+  jvs(50) = 0
+! JVS(51) = Jac_FULL(12,12)
+  jvs(51) = - b(5) - b(12) - b(14) - b(16)
+! JVS(52) = Jac_FULL(12,13)
+  jvs(52) = b(1)
+! JVS(53) = Jac_FULL(13,5)
+  jvs(53) = b(21)
+! JVS(54) = Jac_FULL(13,6)
+  jvs(54) = b(4)
+! JVS(55) = Jac_FULL(13,7)
+  jvs(55) = b(11)
+! JVS(56) = Jac_FULL(13,8)
+  jvs(56) = b(15) - b(19)
+! JVS(57) = Jac_FULL(13,9)
+  jvs(57) = 0
+! JVS(58) = Jac_FULL(13,10)
+  jvs(58) = b(13)
+! JVS(59) = Jac_FULL(13,11)
+  jvs(59) = - b(17)
+! JVS(60) = Jac_FULL(13,12)
+  jvs(60) = b(5) + b(12) + b(14) + b(16)
+! JVS(61) = Jac_FULL(13,13)
+  jvs(61) = - b(1) - b(18) - b(20)
+      
+END SUBROUTINE jac_sp
+ 
+  elemental REAL(kind=dp)FUNCTION k_arr (k_298, tdep, temp)
+    ! arrhenius FUNCTION
+
+    REAL,    INTENT(IN):: k_298 ! k at t = 298.15k
+    REAL,    INTENT(IN):: tdep  ! temperature dependence
+    REAL(kind=dp), INTENT(IN):: temp  ! temperature
+
+    intrinsic exp
+
+    k_arr = k_298 * exp(tdep* (1._dp/temp- 3.3540e-3_dp))! 1/298.15=3.3540e-3
+
+  END FUNCTION k_arr
+ 
+SUBROUTINE update_rconst()
+ INTEGER         :: k
+
+  k = is
+
+! Begin INLINED RCONST
+
+
+! End INLINED RCONST
+
+  rconst(1) = (phot(j_no2))
+  rconst(2) = (arr2(3.2e-11_dp , -70.0_dp , temp))
+  rconst(3) = (arr2(1.8e-12_dp , 1370.0_dp , temp))
+  rconst(4) = (arr2(2.e-11_dp , 500.0_dp , temp))
+  rconst(5) = (arr2(7.0e-12_dp , -250.0_dp , temp))
+  rconst(6) = (phot(j_rcho))
+  rconst(7) = (arr2(3.7e-12_dp , -240.0_dp , temp))
+  rconst(8) = (arr2(4.2e-12_dp , -180.0_dp , temp))
+  rconst(9) = (arr2(5.4e-12_dp , -250.0_dp , temp))
+  rconst(10) = (arr2(1.0e-12_dp , -713.0_dp , temp))
+  rconst(11) = (arr2(1.2e-11_dp , 0.0_dp , temp))
+  rconst(12) = (arr2(9.4e+16_dp , 14000.0_dp , temp))
+      
+END SUBROUTINE update_rconst
+ 
+!  END FUNCTION ARR2
+REAL(kind=dp)FUNCTION arr2( a0, b0, temp)
+    REAL(kind=dp):: temp
+    REAL(kind=dp):: a0, b0
+    arr2 = a0 * exp( - b0 / temp)
+END FUNCTION arr2
+ 
+SUBROUTINE initialize_kpp_ctrl(status)
+
+
+  ! i/o
+  INTEGER,         INTENT(OUT):: status
+
+  ! local
+  REAL(dp):: tsum
+  INTEGER  :: i
+
+  ! check fixed time steps
+  tsum = 0.0_dp
+  DO i=1, nmaxfixsteps
+     IF (t_steps(i)< tiny(0.0_dp))exit
+     tsum = tsum + t_steps(i)
+  ENDDO
+
+  nfsteps = i- 1
+
+  l_fixed_step = (nfsteps > 0).and.((tsum - 1.0)< tiny(0.0_dp))
+
+  IF (l_vector)THEN
+     WRITE(*,*) ' MODE             : VECTOR (LENGTH=',VL_DIM,')'
+  ELSE
+     WRITE(*,*) ' MODE             : SCALAR'
+  ENDIF
+  !
+  WRITE(*,*) ' DE-INDEXING MODE :',I_LU_DI
+  !
+  WRITE(*,*) ' ICNTRL           : ',icntrl
+  WRITE(*,*) ' RCNTRL           : ',rcntrl
+  !
+  ! note: this is ONLY meaningful for vectorized (kp4)rosenbrock- methods
+  IF (l_vector)THEN
+     IF (l_fixed_step)THEN
+        WRITE(*,*) ' TIME STEPS       : FIXED (',t_steps(1:nfsteps),')'
+     ELSE
+        WRITE(*,*) ' TIME STEPS       : AUTOMATIC'
+     ENDIF
+  ELSE
+     WRITE(*,*) ' TIME STEPS       : AUTOMATIC '//&
+          &'(t_steps (CTRL_KPP) ignored in SCALAR MODE)'
+  ENDIF
+  ! mz_pj_20070531- 
+
+  status = 0
+
+
+END SUBROUTINE initialize_kpp_ctrl
+ 
+SUBROUTINE error_output(c, ierr, pe)
+
+
+  INTEGER, INTENT(IN):: ierr
+  INTEGER, INTENT(IN):: pe
+  REAL(dp), DIMENSION(:), INTENT(IN):: c
+
+  write(6,*) 'ERROR in chem_gasphase_mod ',ierr,C(1)
+
+
+END SUBROUTINE error_output
+ 
+      SUBROUTINE wscal(n, alpha, x, incx)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+!     constant times a vector: x(1:N) <- Alpha*x(1:N) 
+!     only for incX=incY=1
+!     after BLAS
+!     replace this by the function from the optimized BLAS implementation:
+!         CALL SSCAL(N,Alpha,X,1) or  CALL DSCAL(N,Alpha,X,1)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+
+      INTEGER  :: i, incx, m, mp1, n
+      REAL(kind=dp) :: x(n), alpha
+      REAL(kind=dp), PARAMETER  :: zero=0.0_dp, one=1.0_dp
+
+      IF (alpha .eq. one)RETURN
+      IF (n .le. 0)RETURN
+
+      m = mod(n, 5)
+      IF ( m .ne. 0)THEN
+        IF (alpha .eq. (- one))THEN
+          DO i = 1, m
+            x(i) = - x(i)
+          ENDDO
+        ELSEIF (alpha .eq. zero)THEN
+          DO i = 1, m
+            x(i) = zero
+          ENDDO
+        ELSE
+          DO i = 1, m
+            x(i) = alpha* x(i)
+          ENDDO
+        ENDIF
+        IF ( n .lt. 5)RETURN
+      ENDIF
+      mp1 = m + 1
+      IF (alpha .eq. (- one))THEN
+        DO i = mp1, n, 5
+          x(i)   = - x(i)
+          x(i + 1) = - x(i + 1)
+          x(i + 2) = - x(i + 2)
+          x(i + 3) = - x(i + 3)
+          x(i + 4) = - x(i + 4)
+        ENDDO
+      ELSEIF (alpha .eq. zero)THEN
+        DO i = mp1, n, 5
+          x(i)   = zero
+          x(i + 1) = zero
+          x(i + 2) = zero
+          x(i + 3) = zero
+          x(i + 4) = zero
+        ENDDO
+      ELSE
+        DO i = mp1, n, 5
+          x(i)   = alpha* x(i)
+          x(i + 1) = alpha* x(i + 1)
+          x(i + 2) = alpha* x(i + 2)
+          x(i + 3) = alpha* x(i + 3)
+          x(i + 4) = alpha* x(i + 4)
+        ENDDO
+      ENDIF
+
+      END SUBROUTINE wscal
+ 
+      SUBROUTINE waxpy(n, alpha, x, incx, y, incy)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+!     constant times a vector plus a vector: y <- y + Alpha*x
+!     only for incX=incY=1
+!     after BLAS
+!     replace this by the function from the optimized BLAS implementation:
+!         CALL SAXPY(N,Alpha,X,1,Y,1) or  CALL DAXPY(N,Alpha,X,1,Y,1)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+
+      INTEGER  :: i, incx, incy, m, mp1, n
+      REAL(kind=dp):: x(n), y(n), alpha
+      REAL(kind=dp), PARAMETER :: zero = 0.0_dp
+
+      IF (alpha .eq. zero)RETURN
+      IF (n .le. 0)RETURN
+
+      m = mod(n, 4)
+      IF ( m .ne. 0)THEN
+        DO i = 1, m
+          y(i) = y(i) + alpha* x(i)
+        ENDDO
+        IF ( n .lt. 4)RETURN
+      ENDIF
+      mp1 = m + 1
+      DO i = mp1, n, 4
+        y(i) = y(i) + alpha* x(i)
+        y(i + 1) = y(i + 1) + alpha* x(i + 1)
+        y(i + 2) = y(i + 2) + alpha* x(i + 2)
+        y(i + 3) = y(i + 3) + alpha* x(i + 3)
+      ENDDO
+      
+      END SUBROUTINE waxpy
+ 
+SUBROUTINE rosenbrock(n, y, tstart, tend, &
+           abstol, reltol,             &
+           rcntrl, icntrl, rstatus, istatus, ierr)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!    Solves the system y'=F(t,y) using a Rosenbrock method defined by:
+!
+!     G = 1/(H*gamma(1)) - Jac(t0,Y0)
+!     T_i = t0 + Alpha(i)*H
+!     Y_i = Y0 + \sum_{j=1}^{i-1} A(i,j)*K_j
+!     G *K_i = Fun( T_i,Y_i)+ \sum_{j=1}^S C(i,j)/H *K_j +
+!         gamma(i)*dF/dT(t0,Y0)
+!     Y1 = Y0 + \sum_{j=1}^S M(j)*K_j
+!
+!    For details on Rosenbrock methods and their implementation consult:
+!      E. Hairer and G. Wanner
+!      "Solving ODEs II. Stiff and differential-algebraic problems".
+!      Springer series in computational mathematics,Springer-Verlag,1996.
+!    The codes contained in the book inspired this implementation.
+!
+!    (C)  Adrian Sandu,August 2004
+!    Virginia Polytechnic Institute and State University
+!    Contact: sandu@cs.vt.edu
+!    Revised by Philipp Miehe and Adrian Sandu,May 2006                  
+!    This implementation is part of KPP - the Kinetic PreProcessor
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!~~~>   input arguments:
+!
+!-     y(n)  = vector of initial conditions (at t=tstart)
+!-    [tstart, tend]  = time range of integration
+!     (if Tstart>Tend the integration is performed backwards in time)
+!-    reltol, abstol = user precribed accuracy
+!- SUBROUTINE  fun( t, y, ydot) = ode FUNCTION, 
+!                       returns Ydot = Y' = F(T,Y)
+!- SUBROUTINE  jac( t, y, jcb) = jacobian of the ode FUNCTION, 
+!                       returns Jcb = dFun/dY
+!-    icntrl(1:20)  = INTEGER inputs PARAMETERs
+!-    rcntrl(1:20)  = REAL inputs PARAMETERs
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!~~~>     output arguments:
+!
+!-    y(n)  - > vector of final states (at t- >tend)
+!-    istatus(1:20) - > INTEGER output PARAMETERs
+!-    rstatus(1:20) - > REAL output PARAMETERs
+!-    ierr            - > job status upon RETURN
+!                        success (positive value) or
+!                        failure (negative value)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!~~~>     input PARAMETERs:
+!
+!    Note: For input parameters equal to zero the default values of the
+!       corresponding variables are used.
+!
+!    ICNTRL(1) = 1: F = F(y)   Independent of T (AUTONOMOUS)
+!              = 0: F = F(t,y) Depends on T (NON-AUTONOMOUS)
+!
+!    ICNTRL(2) = 0: AbsTol,RelTol are N-dimensional vectors
+!              = 1: AbsTol,RelTol are scalars
+!
+!    ICNTRL(3)  -> selection of a particular Rosenbrock method
+!        = 0 :    Rodas3 (default)
+!        = 1 :    Ros2
+!        = 2 :    Ros3
+!        = 3 :    Ros4
+!        = 4 :    Rodas3
+!        = 5 :    Rodas4
+!
+!    ICNTRL(4)  -> maximum number of integration steps
+!        For ICNTRL(4) =0) the default value of 100000 is used
+!
+!    RCNTRL(1)  -> Hmin,lower bound for the integration step size
+!          It is strongly recommended to keep Hmin = ZERO
+!    RCNTRL(2)  -> Hmax,upper bound for the integration step size
+!    RCNTRL(3)  -> Hstart,starting value for the integration step size
+!
+!    RCNTRL(4)  -> FacMin,lower bound on step decrease factor (default=0.2)
+!    RCNTRL(5)  -> FacMax,upper bound on step increase factor (default=6)
+!    RCNTRL(6)  -> FacRej,step decrease factor after multiple rejections
+!                          (default=0.1)
+!    RCNTRL(7)  -> FacSafe,by which the new step is slightly smaller
+!         than the predicted value  (default=0.9)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!
+!
+!    OUTPUT ARGUMENTS:
+!    -----------------
+!
+!    T           -> T value for which the solution has been computed
+!                     (after successful return T=Tend).
+!
+!    Y(N)        -> Numerical solution at T
+!
+!    IDID        -> Reports on successfulness upon return:
+!                    = 1 for success
+!                    < 0 for error (value equals error code)
+!
+!    ISTATUS(1)  -> No. of function calls
+!    ISTATUS(2)  -> No. of jacobian calls
+!    ISTATUS(3)  -> No. of steps
+!    ISTATUS(4)  -> No. of accepted steps
+!    ISTATUS(5)  -> No. of rejected steps (except at very beginning)
+!    ISTATUS(6)  -> No. of LU decompositions
+!    ISTATUS(7)  -> No. of forward/backward substitutions
+!    ISTATUS(8)  -> No. of singular matrix decompositions
+!
+!    RSTATUS(1)  -> Texit,the time corresponding to the
+!                     computed Y upon return
+!    RSTATUS(2)  -> Hexit,last accepted step before exit
+!    RSTATUS(3)  -> Hnew,last predicted step (not yet taken)
+!                   For multiple restarts,use Hnew as Hstart 
+!                     in the subsequent run
+!
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~>  arguments
+   INTEGER,      INTENT(IN)  :: n
+   REAL(kind=dp), INTENT(INOUT):: y(n)
+   REAL(kind=dp), INTENT(IN)  :: tstart, tend
+   REAL(kind=dp), INTENT(IN)  :: abstol(n), reltol(n)
+   INTEGER,      INTENT(IN)  :: icntrl(20)
+   REAL(kind=dp), INTENT(IN)  :: rcntrl(20)
+   INTEGER,      INTENT(INOUT):: istatus(20)
+   REAL(kind=dp), INTENT(INOUT):: rstatus(20)
+   INTEGER, INTENT(OUT) :: ierr
+!~~~>  PARAMETERs of the rosenbrock method, up to 6 stages
+   INTEGER ::  ros_s, rosmethod
+   INTEGER, PARAMETER :: rs2=1, rs3=2, rs4=3, rd3=4, rd4=5, rg3=6
+   REAL(kind=dp):: ros_a(15), ros_c(15), ros_m(6), ros_e(6), &
+                    ros_alpha(6), ros_gamma(6), ros_elo
+   LOGICAL :: ros_newf(6)
+   CHARACTER(len=12):: ros_name
+!~~~>  local variables
+   REAL(kind=dp):: roundoff, facmin, facmax, facrej, facsafe
+   REAL(kind=dp):: hmin, hmax, hstart
+   REAL(kind=dp):: texit
+   INTEGER       :: i, uplimtol, max_no_steps
+   LOGICAL       :: autonomous, vectortol
+!~~~>   PARAMETERs
+   REAL(kind=dp), PARAMETER :: zero = 0.0_dp, one  = 1.0_dp
+   REAL(kind=dp), PARAMETER :: deltamin = 1.0e-5_dp
+
+!~~~>  initialize statistics
+   istatus(1:8) = 0
+   rstatus(1:3) = zero
+
+!~~~>  autonomous or time dependent ode. default is time dependent.
+   autonomous = .not.(icntrl(1) == 0)
+
+!~~~>  for scalar tolerances (icntrl(2).ne.0) the code uses abstol(1)and reltol(1)
+!   For Vector tolerances (ICNTRL(2) == 0) the code uses AbsTol(1:N) and RelTol(1:N)
+   IF (icntrl(2) == 0)THEN
+      vectortol = .TRUE.
+      uplimtol  = n
+   ELSE
+      vectortol = .FALSE.
+      uplimtol  = 1
+   ENDIF
+
+!~~~>   initialize the particular rosenbrock method selected
+   select CASE (icntrl(3))
+     CASE (1)
+       CALL ros2
+     CASE (2)
+       CALL ros3
+     CASE (3)
+       CALL ros4
+     CASE (0, 4)
+       CALL rodas3
+     CASE (5)
+       CALL rodas4
+     CASE (6)
+       CALL rang3
+     CASE default
+       PRINT *,'Unknown Rosenbrock method: ICNTRL(3) =',ICNTRL(3) 
+       CALL ros_errormsg(- 2, tstart, zero, ierr)
+       RETURN
+   END select
+
+!~~~>   the maximum number of steps admitted
+   IF (icntrl(4) == 0)THEN
+      max_no_steps = 200000
+   ELSEIF (icntrl(4)> 0)THEN
+      max_no_steps=icntrl(4)
+   ELSE
+      PRINT *,'User-selected max no. of steps: ICNTRL(4) =',ICNTRL(4)
+      CALL ros_errormsg(- 1, tstart, zero, ierr)
+      RETURN
+   ENDIF
+
+!~~~>  unit roundoff (1+ roundoff>1)
+   roundoff = epsilon(one)
+
+!~~~>  lower bound on the step size: (positive value)
+   IF (rcntrl(1) == zero)THEN
+      hmin = zero
+   ELSEIF (rcntrl(1)> zero)THEN
+      hmin = rcntrl(1)
+   ELSE
+      PRINT *,'User-selected Hmin: RCNTRL(1) =',RCNTRL(1)
+      CALL ros_errormsg(- 3, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  upper bound on the step size: (positive value)
+   IF (rcntrl(2) == zero)THEN
+      hmax = abs(tend-tstart)
+   ELSEIF (rcntrl(2)> zero)THEN
+      hmax = min(abs(rcntrl(2)), abs(tend-tstart))
+   ELSE
+      PRINT *,'User-selected Hmax: RCNTRL(2) =',RCNTRL(2)
+      CALL ros_errormsg(- 3, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  starting step size: (positive value)
+   IF (rcntrl(3) == zero)THEN
+      hstart = max(hmin, deltamin)
+   ELSEIF (rcntrl(3)> zero)THEN
+      hstart = min(abs(rcntrl(3)), abs(tend-tstart))
+   ELSE
+      PRINT *,'User-selected Hstart: RCNTRL(3) =',RCNTRL(3)
+      CALL ros_errormsg(- 3, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  step size can be changed s.t.  facmin < hnew/hold < facmax
+   IF (rcntrl(4) == zero)THEN
+      facmin = 0.2_dp
+   ELSEIF (rcntrl(4)> zero)THEN
+      facmin = rcntrl(4)
+   ELSE
+      PRINT *,'User-selected FacMin: RCNTRL(4) =',RCNTRL(4)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+   IF (rcntrl(5) == zero)THEN
+      facmax = 6.0_dp
+   ELSEIF (rcntrl(5)> zero)THEN
+      facmax = rcntrl(5)
+   ELSE
+      PRINT *,'User-selected FacMax: RCNTRL(5) =',RCNTRL(5)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>   facrej: factor to decrease step after 2 succesive rejections
+   IF (rcntrl(6) == zero)THEN
+      facrej = 0.1_dp
+   ELSEIF (rcntrl(6)> zero)THEN
+      facrej = rcntrl(6)
+   ELSE
+      PRINT *,'User-selected FacRej: RCNTRL(6) =',RCNTRL(6)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>   facsafe: safety factor in the computation of new step size
+   IF (rcntrl(7) == zero)THEN
+      facsafe = 0.9_dp
+   ELSEIF (rcntrl(7)> zero)THEN
+      facsafe = rcntrl(7)
+   ELSE
+      PRINT *,'User-selected FacSafe: RCNTRL(7) =',RCNTRL(7)
+      CALL ros_errormsg(- 4, tstart, zero, ierr)
+      RETURN
+   ENDIF
+!~~~>  check IF tolerances are reasonable
+    DO i=1, uplimtol
+      IF ((abstol(i)<= zero).or. (reltol(i)<= 10.0_dp* roundoff)&
+         .or. (reltol(i)>= 1.0_dp))THEN
+        PRINT *,' AbsTol(',i,') = ',AbsTol(i)
+        PRINT *,' RelTol(',i,') = ',RelTol(i)
+        CALL ros_errormsg(- 5, tstart, zero, ierr)
+        RETURN
+      ENDIF
+    ENDDO
+
+
+!~~~>  CALL rosenbrock method
+   CALL ros_integrator(y, tstart, tend, texit,  &
+        abstol, reltol,                         &
+!  Integration parameters
+        autonomous, vectortol, max_no_steps,    &
+        roundoff, hmin, hmax, hstart,           &
+        facmin, facmax, facrej, facsafe,        &
+!  Error indicator
+        ierr)
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+CONTAINS !  SUBROUTINEs internal to rosenbrock
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
+ SUBROUTINE ros_errormsg(code, t, h, ierr)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
+!    Handles all error messages
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~   
+  
+   REAL(kind=dp), INTENT(IN):: t, h
+   INTEGER, INTENT(IN) :: code
+   INTEGER, INTENT(OUT):: ierr
+   
+   ierr = code
+   print * , &
+     'Forced exit from Rosenbrock due to the following error:' 
+     
+   select CASE (code)
+    CASE (- 1)  
+      PRINT *,'--> Improper value for maximal no of steps'
+    CASE (- 2)  
+      PRINT *,'--> Selected Rosenbrock method not implemented'
+    CASE (- 3)  
+      PRINT *,'--> Hmin/Hmax/Hstart must be positive'
+    CASE (- 4)  
+      PRINT *,'--> FacMin/FacMax/FacRej must be positive'
+    CASE (- 5)
+      PRINT *,'--> Improper tolerance values'
+    CASE (- 6)
+      PRINT *,'--> No of steps exceeds maximum bound'
+    CASE (- 7)
+      PRINT *,'--> Step size too small: T + 10*H = T',&
+            ' or H < Roundoff'
+    CASE (- 8)  
+      PRINT *,'--> Matrix is repeatedly singular'
+    CASE default
+      PRINT *,'Unknown Error code: ',Code
+   END select
+   
+   print * , "t=", t, "and h=", h
+     
+ END SUBROUTINE ros_errormsg
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ SUBROUTINE ros_integrator (y, tstart, tend, t, &
+        abstol, reltol,                         &
+!~~~> integration PARAMETERs
+        autonomous, vectortol, max_no_steps,    &
+        roundoff, hmin, hmax, hstart,           &
+        facmin, facmax, facrej, facsafe,        &
+!~~~> error indicator
+        ierr)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!   Template for the implementation of a generic Rosenbrock method
+!      defined by ros_S (no of stages)
+!      and its coefficients ros_{A,C,M,E,Alpha,Gamma}
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~> input: the initial condition at tstart; output: the solution at t
+   REAL(kind=dp), INTENT(INOUT):: y(n)
+!~~~> input: integration interval
+   REAL(kind=dp), INTENT(IN):: tstart, tend
+!~~~> output: time at which the solution is RETURNed (t=tendIF success)
+   REAL(kind=dp), INTENT(OUT)::  t
+!~~~> input: tolerances
+   REAL(kind=dp), INTENT(IN)::  abstol(n), reltol(n)
+!~~~> input: integration PARAMETERs
+   LOGICAL, INTENT(IN):: autonomous, vectortol
+   REAL(kind=dp), INTENT(IN):: hstart, hmin, hmax
+   INTEGER, INTENT(IN):: max_no_steps
+   REAL(kind=dp), INTENT(IN):: roundoff, facmin, facmax, facrej, facsafe
+!~~~> output: error indicator
+   INTEGER, INTENT(OUT):: ierr
+! ~~~~ Local variables
+   REAL(kind=dp):: ynew(n), fcn0(n), fcn(n)
+   REAL(kind=dp):: k(n* ros_s), dfdt(n)
+#ifdef full_algebra    
+   REAL(kind=dp):: jac0(n, n), ghimj(n, n)
+#else
+   REAL(kind=dp):: jac0(lu_nonzero), ghimj(lu_nonzero)
+#endif
+   REAL(kind=dp):: h, hnew, hc, hg, fac, tau
+   REAL(kind=dp):: err, yerr(n)
+   INTEGER :: pivot(n), direction, ioffset, j, istage
+   LOGICAL :: rejectlasth, rejectmoreh, singular
+!~~~>  local PARAMETERs
+   REAL(kind=dp), PARAMETER :: zero = 0.0_dp, one  = 1.0_dp
+   REAL(kind=dp), PARAMETER :: deltamin = 1.0e-5_dp
+!~~~>  locally called FUNCTIONs
+!    REAL(kind=dp) WLAMCH
+!    EXTERNAL WLAMCH
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~>  initial preparations
+   t = tstart
+   rstatus(nhexit) = zero
+   h = min( max(abs(hmin), abs(hstart)), abs(hmax))
+   IF (abs(h)<= 10.0_dp* roundoff)h = deltamin
+
+   IF (tend  >=  tstart)THEN
+     direction = + 1
+   ELSE
+     direction = - 1
+   ENDIF
+   h = direction* h
+
+   rejectlasth=.FALSE.
+   rejectmoreh=.FALSE.
+
+!~~~> time loop begins below
+
+timeloop: DO WHILE((direction > 0).and.((t- tend) + roundoff <= zero)&
+       .or. (direction < 0).and.((tend-t) + roundoff <= zero))
+
+   IF (istatus(nstp)> max_no_steps)THEN  ! too many steps
+      CALL ros_errormsg(- 6, t, h, ierr)
+      RETURN
+   ENDIF
+   IF (((t+ 0.1_dp* h) == t).or.(h <= roundoff))THEN  ! step size too small
+      CALL ros_errormsg(- 7, t, h, ierr)
+      RETURN
+   ENDIF
+
+!~~~>  limit h IF necessary to avoid going beyond tend
+   h = min(h, abs(tend-t))
+
+!~~~>   compute the FUNCTION at current time
+   CALL funtemplate(t, y, fcn0)
+   istatus(nfun) = istatus(nfun) + 1
+
+!~~~>  compute the FUNCTION derivative with respect to t
+   IF (.not.autonomous)THEN
+      CALL ros_funtimederivative(t, roundoff, y, &
+                fcn0, dfdt)
+   ENDIF
+
+!~~~>   compute the jacobian at current time
+   CALL jactemplate(t, y, jac0)
+   istatus(njac) = istatus(njac) + 1
+
+!~~~>  repeat step calculation until current step accepted
+untilaccepted: do
+
+   CALL ros_preparematrix(h, direction, ros_gamma(1), &
+          jac0, ghimj, pivot, singular)
+   IF (singular)THEN ! more than 5 consecutive failed decompositions
+       CALL ros_errormsg(- 8, t, h, ierr)
+       RETURN
+   ENDIF
+
+!~~~>   compute the stages
+stage: DO istage = 1, ros_s
+
+      ! current istage offset. current istage vector is k(ioffset+ 1:ioffset+ n)
+       ioffset = n* (istage-1)
+
+      ! for the 1st istage the FUNCTION has been computed previously
+       IF (istage == 1)THEN
+         !slim: CALL wcopy(n, fcn0, 1, fcn, 1)
+       fcn(1:n) = fcn0(1:n)
+      ! istage>1 and a new FUNCTION evaluation is needed at the current istage
+       ELSEIF(ros_newf(istage))THEN
+         !slim: CALL wcopy(n, y, 1, ynew, 1)
+       ynew(1:n) = y(1:n)
+         DO j = 1, istage-1
+           CALL waxpy(n, ros_a((istage-1) * (istage-2) /2+ j), &
+            k(n* (j- 1) + 1), 1, ynew, 1)
+         ENDDO
+         tau = t + ros_alpha(istage) * direction* h
+         CALL funtemplate(tau, ynew, fcn)
+         istatus(nfun) = istatus(nfun) + 1
+       ENDIF ! IF istage == 1 ELSEIF ros_newf(istage)
+       !slim: CALL wcopy(n, fcn, 1, k(ioffset+ 1), 1)
+       k(ioffset+ 1:ioffset+ n) = fcn(1:n)
+       DO j = 1, istage-1
+         hc = ros_c((istage-1) * (istage-2) /2+ j) /(direction* h)
+         CALL waxpy(n, hc, k(n* (j- 1) + 1), 1, k(ioffset+ 1), 1)
+       ENDDO
+       IF ((.not. autonomous).and.(ros_gamma(istage).ne.zero))THEN
+         hg = direction* h* ros_gamma(istage)
+         CALL waxpy(n, hg, dfdt, 1, k(ioffset+ 1), 1)
+       ENDIF
+       CALL ros_solve(ghimj, pivot, k(ioffset+ 1))
+
+   END DO stage
+
+
+!~~~>  compute the new solution
+   !slim: CALL wcopy(n, y, 1, ynew, 1)
+   ynew(1:n) = y(1:n)
+   DO j=1, ros_s
+         CALL waxpy(n, ros_m(j), k(n* (j- 1) + 1), 1, ynew, 1)
+   ENDDO
+
+!~~~>  compute the error estimation
+   !slim: CALL wscal(n, zero, yerr, 1)
+   yerr(1:n) = zero
+   DO j=1, ros_s
+        CALL waxpy(n, ros_e(j), k(n* (j- 1) + 1), 1, yerr, 1)
+   ENDDO
+   err = ros_errornorm(y, ynew, yerr, abstol, reltol, vectortol)
+
+!~~~> new step size is bounded by facmin <= hnew/h <= facmax
+   fac  = min(facmax, max(facmin, facsafe/err** (one/ros_elo)))
+   hnew = h* fac
+
+!~~~>  check the error magnitude and adjust step size
+   istatus(nstp) = istatus(nstp) + 1
+   IF ((err <= one).or.(h <= hmin))THEN  !~~~> accept step
+      istatus(nacc) = istatus(nacc) + 1
+      !slim: CALL wcopy(n, ynew, 1, y, 1)
+      y(1:n) = ynew(1:n)
+      t = t + direction* h
+      hnew = max(hmin, min(hnew, hmax))
+      IF (rejectlasth)THEN  ! no step size increase after a rejected step
+         hnew = min(hnew, h)
+      ENDIF
+      rstatus(nhexit) = h
+      rstatus(nhnew) = hnew
+      rstatus(ntexit) = t
+      rejectlasth = .FALSE.
+      rejectmoreh = .FALSE.
+      h = hnew
+      exit untilaccepted ! exit the loop: WHILE step not accepted
+   ELSE           !~~~> reject step
+      IF (rejectmoreh)THEN
+         hnew = h* facrej
+      ENDIF
+      rejectmoreh = rejectlasth
+      rejectlasth = .TRUE.
+      h = hnew
+      IF (istatus(nacc)>= 1) istatus(nrej) = istatus(nrej) + 1
+   ENDIF ! err <= 1
+
+   END DO untilaccepted
+
+   END DO timeloop
+
+!~~~> succesful exit
+   ierr = 1  !~~~> the integration was successful
+
+  END SUBROUTINE ros_integrator
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  REAL(kind=dp)FUNCTION ros_errornorm(y, ynew, yerr, &
+                               abstol, reltol, vectortol)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> computes the "scaled norm" of the error vector yerr
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+! Input arguments
+   REAL(kind=dp), INTENT(IN):: y(n), ynew(n), &
+          yerr(n), abstol(n), reltol(n)
+   LOGICAL, INTENT(IN)::  vectortol
+! Local variables
+   REAL(kind=dp):: err, scale, ymax
+   INTEGER  :: i
+   REAL(kind=dp), PARAMETER :: zero = 0.0_dp
+
+   err = zero
+   DO i=1, n
+     ymax = max(abs(y(i)), abs(ynew(i)))
+     IF (vectortol)THEN
+       scale = abstol(i) + reltol(i) * ymax
+     ELSE
+       scale = abstol(1) + reltol(1) * ymax
+     ENDIF
+     err = err+ (yerr(i) /scale) ** 2
+   ENDDO
+   err  = sqrt(err/n)
+
+   ros_errornorm = max(err, 1.0d-10)
+
+  END FUNCTION ros_errornorm
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_funtimederivative(t, roundoff, y, &
+                fcn0, dfdt)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> the time partial derivative of the FUNCTION by finite differences
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+!~~~> input arguments
+   REAL(kind=dp), INTENT(IN):: t, roundoff, y(n), fcn0(n)
+!~~~> output arguments
+   REAL(kind=dp), INTENT(OUT):: dfdt(n)
+!~~~> local variables
+   REAL(kind=dp):: delta
+   REAL(kind=dp), PARAMETER :: one = 1.0_dp, deltamin = 1.0e-6_dp
+
+   delta = sqrt(roundoff) * max(deltamin, abs(t))
+   CALL funtemplate(t+ delta, y, dfdt)
+   istatus(nfun) = istatus(nfun) + 1
+   CALL waxpy(n, (- one), fcn0, 1, dfdt, 1)
+   CALL wscal(n, (one/delta), dfdt, 1)
+
+  END SUBROUTINE ros_funtimederivative
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_preparematrix(h, direction, gam, &
+             jac0, ghimj, pivot, singular)
+! --- --- --- --- --- --- --- --- --- --- --- --- ---
+!  Prepares the LHS matrix for stage calculations
+!  1.  Construct Ghimj = 1/(H*ham) - Jac0
+!      "(Gamma H) Inverse Minus Jacobian"
+!  2.  Repeat LU decomposition of Ghimj until successful.
+!       -half the step size if LU decomposition fails and retry
+!       -exit after 5 consecutive fails
+! --- --- --- --- --- --- --- --- --- --- --- --- ---
+
+!~~~> input arguments
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(IN)::  jac0(n, n)
+#else
+   REAL(kind=dp), INTENT(IN)::  jac0(lu_nonzero)
+#endif   
+   REAL(kind=dp), INTENT(IN)::  gam
+   INTEGER, INTENT(IN)::  direction
+!~~~> output arguments
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(OUT):: ghimj(n, n)
+#else
+   REAL(kind=dp), INTENT(OUT):: ghimj(lu_nonzero)
+#endif   
+   LOGICAL, INTENT(OUT)::  singular
+   INTEGER, INTENT(OUT)::  pivot(n)
+!~~~> inout arguments
+   REAL(kind=dp), INTENT(INOUT):: h   ! step size is decreased when lu fails
+!~~~> local variables
+   INTEGER  :: i, ising, nconsecutive
+   REAL(kind=dp):: ghinv
+   REAL(kind=dp), PARAMETER :: one  = 1.0_dp, half = 0.5_dp
+
+   nconsecutive = 0
+   singular = .TRUE.
+
+   DO WHILE (singular)
+
+!~~~>    construct ghimj = 1/(h* gam) - jac0
+#ifdef full_algebra    
+     !slim: CALL wcopy(n* n, jac0, 1, ghimj, 1)
+     !slim: CALL wscal(n* n, (- one), ghimj, 1)
+     ghimj = - jac0
+     ghinv = one/(direction* h* gam)
+     DO i=1, n
+       ghimj(i, i) = ghimj(i, i) + ghinv
+     ENDDO
+#else
+     !slim: CALL wcopy(lu_nonzero, jac0, 1, ghimj, 1)
+     !slim: CALL wscal(lu_nonzero, (- one), ghimj, 1)
+     ghimj(1:lu_nonzero) = - jac0(1:lu_nonzero)
+     ghinv = one/(direction* h* gam)
+     DO i=1, n
+       ghimj(lu_diag(i)) = ghimj(lu_diag(i)) + ghinv
+     ENDDO
+#endif   
+!~~~>    compute lu decomposition
+     CALL ros_decomp( ghimj, pivot, ising)
+     IF (ising == 0)THEN
+!~~~>    IF successful done
+        singular = .FALSE.
+     ELSE ! ising .ne. 0
+!~~~>    IF unsuccessful half the step size; IF 5 consecutive fails THEN RETURN
+        istatus(nsng) = istatus(nsng) + 1
+        nconsecutive = nconsecutive+1
+        singular = .TRUE.
+        PRINT*,'Warning: LU Decomposition returned ISING = ',ISING
+        IF (nconsecutive <= 5)THEN ! less than 5 consecutive failed decompositions
+           h = h* half
+        ELSE  ! more than 5 consecutive failed decompositions
+           RETURN
+        ENDIF  ! nconsecutive
+      ENDIF    ! ising
+
+   END DO ! WHILE singular
+
+  END SUBROUTINE ros_preparematrix
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_decomp( a, pivot, ising)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the LU decomposition
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> inout variables
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(INOUT):: a(n, n)
+#else   
+   REAL(kind=dp), INTENT(INOUT):: a(lu_nonzero)
+#endif
+!~~~> output variables
+   INTEGER, INTENT(OUT):: pivot(n), ising
+
+#ifdef full_algebra    
+   CALL  dgetrf( n, n, a, n, pivot, ising)
+#else   
+   CALL kppdecomp(a, ising)
+   pivot(1) = 1
+#endif
+   istatus(ndec) = istatus(ndec) + 1
+
+  END SUBROUTINE ros_decomp
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros_solve( a, pivot, b)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the forward/backward substitution (using pre-computed LU decomposition)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> input variables
+#ifdef full_algebra    
+   REAL(kind=dp), INTENT(IN):: a(n, n)
+   INTEGER :: ising
+#else   
+   REAL(kind=dp), INTENT(IN):: a(lu_nonzero)
+#endif
+   INTEGER, INTENT(IN):: pivot(n)
+!~~~> inout variables
+   REAL(kind=dp), INTENT(INOUT):: b(n)
+
+#ifdef full_algebra    
+   CALL  DGETRS( 'N',N ,1,A,N,Pivot,b,N,ISING)
+   IF (info < 0)THEN
+      print* , "error in dgetrs. ising=", ising
+   ENDIF  
+#else   
+   CALL kppsolve( a, b)
+#endif
+
+   istatus(nsol) = istatus(nsol) + 1
+
+  END SUBROUTINE ros_solve
+
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros2
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! --- AN L-STABLE METHOD,2 stages,order 2
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+   double precision g
+
+    g = 1.0_dp + 1.0_dp/sqrt(2.0_dp)
+    rosmethod = rs2
+!~~~> name of the method
+    ros_Name = 'ROS-2'
+!~~~> number of stages
+    ros_s = 2
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+    ros_a(1) = (1.0_dp) /g
+    ros_c(1) = (- 2.0_dp) /g
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+    ros_newf(1) = .TRUE.
+    ros_newf(2) = .TRUE.
+!~~~> m_i = coefficients for new step solution
+    ros_m(1) = (3.0_dp) /(2.0_dp* g)
+    ros_m(2) = (1.0_dp) /(2.0_dp* g)
+! E_i = Coefficients for error estimator
+    ros_e(1) = 1.0_dp/(2.0_dp* g)
+    ros_e(2) = 1.0_dp/(2.0_dp* g)
+!~~~> ros_elo = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus one
+    ros_elo = 2.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+    ros_alpha(1) = 0.0_dp
+    ros_alpha(2) = 1.0_dp
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+    ros_gamma(1) = g
+    ros_gamma(2) = -g
+
+ END SUBROUTINE ros2
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! --- AN L-STABLE METHOD,3 stages,order 3,2 function evaluations
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+   rosmethod = rs3
+!~~~> name of the method
+   ros_Name = 'ROS-3'
+!~~~> number of stages
+   ros_s = 3
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+   ros_a(1) = 1.0_dp
+   ros_a(2) = 1.0_dp
+   ros_a(3) = 0.0_dp
+
+   ros_c(1) = - 0.10156171083877702091975600115545e+01_dp
+   ros_c(2) =  0.40759956452537699824805835358067e+01_dp
+   ros_c(3) =  0.92076794298330791242156818474003e+01_dp
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+   ros_newf(1) = .TRUE.
+   ros_newf(2) = .TRUE.
+   ros_newf(3) = .FALSE.
+!~~~> m_i = coefficients for new step solution
+   ros_m(1) =  0.1e+01_dp
+   ros_m(2) =  0.61697947043828245592553615689730e+01_dp
+   ros_m(3) = - 0.42772256543218573326238373806514_dp
+! E_i = Coefficients for error estimator
+   ros_e(1) =  0.5_dp
+   ros_e(2) = - 0.29079558716805469821718236208017e+01_dp
+   ros_e(3) =  0.22354069897811569627360909276199_dp
+!~~~> ros_elo = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus 1
+   ros_elo = 3.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+   ros_alpha(1) = 0.0_dp
+   ros_alpha(2) = 0.43586652150845899941601945119356_dp
+   ros_alpha(3) = 0.43586652150845899941601945119356_dp
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+   ros_gamma(1) = 0.43586652150845899941601945119356_dp
+   ros_gamma(2) = 0.24291996454816804366592249683314_dp
+   ros_gamma(3) = 0.21851380027664058511513169485832e+01_dp
+
+  END SUBROUTINE ros3
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE ros4
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     L-STABLE ROSENBROCK METHOD OF ORDER 4,WITH 4 STAGES
+!     L-STABLE EMBEDDED ROSENBROCK METHOD OF ORDER 3
+!
+!      E. HAIRER AND G. WANNER,SOLVING ORDINARY DIFFERENTIAL
+!      EQUATIONS II. STIFF AND DIFFERENTIAL-ALGEBRAIC PROBLEMS.
+!      SPRINGER SERIES IN COMPUTATIONAL MATHEMATICS,
+!      SPRINGER-VERLAG (1990)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+   rosmethod = rs4
+!~~~> name of the method
+   ros_Name = 'ROS-4'
+!~~~> number of stages
+   ros_s = 4
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+   ros_a(1) = 0.2000000000000000e+01_dp
+   ros_a(2) = 0.1867943637803922e+01_dp
+   ros_a(3) = 0.2344449711399156_dp
+   ros_a(4) = ros_a(2)
+   ros_a(5) = ros_a(3)
+   ros_a(6) = 0.0_dp
+
+   ros_c(1) = -0.7137615036412310e+01_dp
+   ros_c(2) = 0.2580708087951457e+01_dp
+   ros_c(3) = 0.6515950076447975_dp
+   ros_c(4) = -0.2137148994382534e+01_dp
+   ros_c(5) = -0.3214669691237626_dp
+   ros_c(6) = -0.6949742501781779_dp
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+   ros_newf(1) = .TRUE.
+   ros_newf(2) = .TRUE.
+   ros_newf(3) = .TRUE.
+   ros_newf(4) = .FALSE.
+!~~~> m_i = coefficients for new step solution
+   ros_m(1) = 0.2255570073418735e+01_dp
+   ros_m(2) = 0.2870493262186792_dp
+   ros_m(3) = 0.4353179431840180_dp
+   ros_m(4) = 0.1093502252409163e+01_dp
+!~~~> e_i  = coefficients for error estimator
+   ros_e(1) = -0.2815431932141155_dp
+   ros_e(2) = -0.7276199124938920e-01_dp
+   ros_e(3) = -0.1082196201495311_dp
+   ros_e(4) = -0.1093502252409163e+01_dp
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus 1
+   ros_elo  = 4.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+   ros_alpha(1) = 0.0_dp
+   ros_alpha(2) = 0.1145640000000000e+01_dp
+   ros_alpha(3) = 0.6552168638155900_dp
+   ros_alpha(4) = ros_alpha(3)
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+   ros_gamma(1) = 0.5728200000000000_dp
+   ros_gamma(2) = -0.1769193891319233e+01_dp
+   ros_gamma(3) = 0.7592633437920482_dp
+   ros_gamma(4) = -0.1049021087100450_dp
+
+  END SUBROUTINE ros4
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE rodas3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! --- A STIFFLY-STABLE METHOD,4 stages,order 3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+   rosmethod = rd3
+!~~~> name of the method
+   ros_Name = 'RODAS-3'
+!~~~> number of stages
+   ros_s = 4
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:
+!       A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!       C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+   ros_a(1) = 0.0_dp
+   ros_a(2) = 2.0_dp
+   ros_a(3) = 0.0_dp
+   ros_a(4) = 2.0_dp
+   ros_a(5) = 0.0_dp
+   ros_a(6) = 1.0_dp
+
+   ros_c(1) = 4.0_dp
+   ros_c(2) = 1.0_dp
+   ros_c(3) = -1.0_dp
+   ros_c(4) = 1.0_dp
+   ros_c(5) = -1.0_dp
+   ros_c(6) = -(8.0_dp/3.0_dp)
+
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+   ros_newf(1) = .TRUE.
+   ros_newf(2) = .FALSE.
+   ros_newf(3) = .TRUE.
+   ros_newf(4) = .TRUE.
+!~~~> m_i = coefficients for new step solution
+   ros_m(1) = 2.0_dp
+   ros_m(2) = 0.0_dp
+   ros_m(3) = 1.0_dp
+   ros_m(4) = 1.0_dp
+!~~~> e_i  = coefficients for error estimator
+   ros_e(1) = 0.0_dp
+   ros_e(2) = 0.0_dp
+   ros_e(3) = 0.0_dp
+   ros_e(4) = 1.0_dp
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!    main and the embedded scheme orders plus 1
+   ros_elo  = 3.0_dp
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+   ros_alpha(1) = 0.0_dp
+   ros_alpha(2) = 0.0_dp
+   ros_alpha(3) = 1.0_dp
+   ros_alpha(4) = 1.0_dp
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+   ros_gamma(1) = 0.5_dp
+   ros_gamma(2) = 1.5_dp
+   ros_gamma(3) = 0.0_dp
+   ros_gamma(4) = 0.0_dp
+
+  END SUBROUTINE rodas3
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE rodas4
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     STIFFLY-STABLE ROSENBROCK METHOD OF ORDER 4,WITH 6 STAGES
+!
+!      E. HAIRER AND G. WANNER,SOLVING ORDINARY DIFFERENTIAL
+!      EQUATIONS II. STIFF AND DIFFERENTIAL-ALGEBRAIC PROBLEMS.
+!      SPRINGER SERIES IN COMPUTATIONAL MATHEMATICS,
+!      SPRINGER-VERLAG (1996)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+    rosmethod = rd4
+!~~~> name of the method
+    ros_Name = 'RODAS-4'
+!~~~> number of stages
+    ros_s = 6
+
+!~~~> y_stage_i ~ y( t + h* alpha_i)
+    ros_alpha(1) = 0.000_dp
+    ros_alpha(2) = 0.386_dp
+    ros_alpha(3) = 0.210_dp
+    ros_alpha(4) = 0.630_dp
+    ros_alpha(5) = 1.000_dp
+    ros_alpha(6) = 1.000_dp
+
+!~~~> gamma_i = \sum_j  gamma_{i, j}
+    ros_gamma(1) = 0.2500000000000000_dp
+    ros_gamma(2) = -0.1043000000000000_dp
+    ros_gamma(3) = 0.1035000000000000_dp
+    ros_gamma(4) = -0.3620000000000023e-01_dp
+    ros_gamma(5) = 0.0_dp
+    ros_gamma(6) = 0.0_dp
+
+!~~~> the coefficient matrices a and c are strictly lower triangular.
+!   The lower triangular (subdiagonal) elements are stored in row-wise order:
+!   A(2,1) = ros_A(1),A(3,1) =ros_A(2),A(3,2) =ros_A(3),etc.
+!   The general mapping formula is:  A(i,j) = ros_A( (i-1)*(i-2)/2 + j)
+!                  C(i,j) = ros_C( (i-1)*(i-2)/2 + j)
+
+    ros_a(1) = 0.1544000000000000e+01_dp
+    ros_a(2) = 0.9466785280815826_dp
+    ros_a(3) = 0.2557011698983284_dp
+    ros_a(4) = 0.3314825187068521e+01_dp
+    ros_a(5) = 0.2896124015972201e+01_dp
+    ros_a(6) = 0.9986419139977817_dp
+    ros_a(7) = 0.1221224509226641e+01_dp
+    ros_a(8) = 0.6019134481288629e+01_dp
+    ros_a(9) = 0.1253708332932087e+02_dp
+    ros_a(10) = -0.6878860361058950_dp
+    ros_a(11) = ros_a(7)
+    ros_a(12) = ros_a(8)
+    ros_a(13) = ros_a(9)
+    ros_a(14) = ros_a(10)
+    ros_a(15) = 1.0_dp
+
+    ros_c(1) = -0.5668800000000000e+01_dp
+    ros_c(2) = -0.2430093356833875e+01_dp
+    ros_c(3) = -0.2063599157091915_dp
+    ros_c(4) = -0.1073529058151375_dp
+    ros_c(5) = -0.9594562251023355e+01_dp
+    ros_c(6) = -0.2047028614809616e+02_dp
+    ros_c(7) = 0.7496443313967647e+01_dp
+    ros_c(8) = -0.1024680431464352e+02_dp
+    ros_c(9) = -0.3399990352819905e+02_dp
+    ros_c(10) = 0.1170890893206160e+02_dp
+    ros_c(11) = 0.8083246795921522e+01_dp
+    ros_c(12) = -0.7981132988064893e+01_dp
+    ros_c(13) = -0.3152159432874371e+02_dp
+    ros_c(14) = 0.1631930543123136e+02_dp
+    ros_c(15) = -0.6058818238834054e+01_dp
+
+!~~~> m_i = coefficients for new step solution
+    ros_m(1) = ros_a(7)
+    ros_m(2) = ros_a(8)
+    ros_m(3) = ros_a(9)
+    ros_m(4) = ros_a(10)
+    ros_m(5) = 1.0_dp
+    ros_m(6) = 1.0_dp
+
+!~~~> e_i  = coefficients for error estimator
+    ros_e(1) = 0.0_dp
+    ros_e(2) = 0.0_dp
+    ros_e(3) = 0.0_dp
+    ros_e(4) = 0.0_dp
+    ros_e(5) = 0.0_dp
+    ros_e(6) = 1.0_dp
+
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+    ros_newf(1) = .TRUE.
+    ros_newf(2) = .TRUE.
+    ros_newf(3) = .TRUE.
+    ros_newf(4) = .TRUE.
+    ros_newf(5) = .TRUE.
+    ros_newf(6) = .TRUE.
+
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!        main and the embedded scheme orders plus 1
+    ros_elo = 4.0_dp
+
+  END SUBROUTINE rodas4
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  SUBROUTINE rang3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! STIFFLY-STABLE W METHOD OF ORDER 3,WITH 4 STAGES
+!
+! J. RANG and L. ANGERMANN
+! NEW ROSENBROCK W-METHODS OF ORDER 3
+! FOR PARTIAL DIFFERENTIAL ALGEBRAIC
+!        EQUATIONS OF INDEX 1                                             
+! BIT Numerical Mathematics (2005) 45: 761-787
+!  DOI: 10.1007/s10543-005-0035-y
+! Table 4.1-4.2
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+    rosmethod = rg3
+!~~~> name of the method
+    ros_Name = 'RANG-3'
+!~~~> number of stages
+    ros_s = 4
+
+    ros_a(1) = 5.09052051067020d+00;
+    ros_a(2) = 5.09052051067020d+00;
+    ros_a(3) = 0.0d0;
+    ros_a(4) = 4.97628111010787d+00;
+    ros_a(5) = 2.77268164715849d-02;
+    ros_a(6) = 2.29428036027904d-01;
+
+    ros_c(1) = - 1.16790812312283d+01;
+    ros_c(2) = - 1.64057326467367d+01;
+    ros_c(3) = - 2.77268164715850d-01;
+    ros_c(4) = - 8.38103960500476d+00;
+    ros_c(5) = - 8.48328409199343d-01;
+    ros_c(6) =  2.87009860433106d-01;
+
+    ros_m(1) =  5.22582761233094d+00;
+    ros_m(2) = - 5.56971148154165d-01;
+    ros_m(3) =  3.57979469353645d-01;
+    ros_m(4) =  1.72337398521064d+00;
+
+    ros_e(1) = - 5.16845212784040d+00;
+    ros_e(2) = - 1.26351942603842d+00;
+    ros_e(3) = - 1.11022302462516d-16;
+    ros_e(4) =  2.22044604925031d-16;
+
+    ros_alpha(1) = 0.0d00;
+    ros_alpha(2) = 2.21878746765329d+00;
+    ros_alpha(3) = 2.21878746765329d+00;
+    ros_alpha(4) = 1.55392337535788d+00;
+
+    ros_gamma(1) =  4.35866521508459d-01;
+    ros_gamma(2) = - 1.78292094614483d+00;
+    ros_gamma(3) = - 2.46541900496934d+00;
+    ros_gamma(4) = - 8.05529997906370d-01;
+
+
+!~~~> does the stage i require a new FUNCTION evaluation (ros_newf(i) =true)
+!   or does it re-use the function evaluation from stage i-1 (ros_NewF(i) =FALSE)
+    ros_newf(1) = .TRUE.
+    ros_newf(2) = .TRUE.
+    ros_newf(3) = .TRUE.
+    ros_newf(4) = .TRUE.
+
+!~~~> ros_elo  = estimator of local order - the minimum between the
+!        main and the embedded scheme orders plus 1
+    ros_elo = 3.0_dp
+
+  END SUBROUTINE rang3
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!   End of the set of internal Rosenbrock subroutines
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END SUBROUTINE rosenbrock
+ 
+SUBROUTINE funtemplate( t, y, ydot)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the ODE function call.
+!  Updates the rate coefficients (and possibly the fixed species) at each call
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> input variables
+   REAL(kind=dp):: t, y(nvar)
+!~~~> output variables
+   REAL(kind=dp):: ydot(nvar)
+!~~~> local variables
+   REAL(kind=dp):: told
+
+   told = time
+   time = t
+   CALL fun( y, fix, rconst, ydot)
+   time = told
+
+END SUBROUTINE funtemplate
+ 
+SUBROUTINE jactemplate( t, y, jcb)
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!  Template for the ODE Jacobian call.
+!  Updates the rate coefficients (and possibly the fixed species) at each call
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!~~~> input variables
+    REAL(kind=dp):: t, y(nvar)
+!~~~> output variables
+#ifdef full_algebra    
+    REAL(kind=dp):: jv(lu_nonzero), jcb(nvar, nvar)
+#else
+    REAL(kind=dp):: jcb(lu_nonzero)
+#endif   
+!~~~> local variables
+    REAL(kind=dp):: told
+#ifdef full_algebra    
+    INTEGER :: i, j
+#endif   
+
+    told = time
+    time = t
+#ifdef full_algebra    
+    CALL jac_sp(y, fix, rconst, jv)
+    DO j=1, nvar
+      DO i=1, nvar
+         jcb(i, j) = 0.0_dp
+      ENDDO
+    ENDDO
+    DO i=1, lu_nonzero
+       jcb(lu_irow(i), lu_icol(i)) = jv(i)
+    ENDDO
+#else
+    CALL jac_sp( y, fix, rconst, jcb)
+#endif   
+    time = told
+
+END SUBROUTINE jactemplate
+ 
+  SUBROUTINE kppdecomp( jvs, ier)                                    
+  ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
+  !        sparse lu factorization                                    
+  ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
+  ! loop expansion generated by kp4                                   
+                                                                      
+    INTEGER  :: ier                                                   
+    REAL(kind=dp):: jvs(lu_nonzero), w(nvar), a             
+    INTEGER  :: k, kk, j, jj                                          
+                                                                      
+    a = 0.                                                            
+    ier = 0                                                           
+                                                                      
+!   i = 1
+!   i = 2
+!   i = 3
+!   i = 4
+!   i = 5
+!   i = 6
+    jvs(13) = (jvs(13)) / jvs(6) 
+    jvs(16) = jvs(16) - jvs(7) * jvs(13)
+!   i = 7
+!   i = 8
+    jvs(21) = (jvs(21)) / jvs(10) 
+    jvs(22) = jvs(22) - jvs(11) * jvs(21)
+    jvs(26) = jvs(26) - jvs(12) * jvs(21)
+!   i = 9
+!   i = 10
+    jvs(31) = (jvs(31)) / jvs(8) 
+    jvs(32) = (jvs(32)) / jvs(22) 
+    a = 0.0; a = a  - jvs(23) * jvs(32)
+    jvs(33) = (jvs(33) + a) / jvs(27) 
+    jvs(34) = jvs(34) - jvs(28) * jvs(33)
+    jvs(35) = jvs(35) - jvs(9) * jvs(31) - jvs(24) * jvs(32) - jvs(29) * jvs(33)
+    jvs(36) = jvs(36) - jvs(25) * jvs(32) - jvs(30) * jvs(33)
+    jvs(37) = jvs(37) - jvs(26) * jvs(32)
+!   i = 11
+    jvs(38) = (jvs(38)) / jvs(8) 
+    jvs(39) = (jvs(39)) / jvs(17) 
+    a = 0.0; a = a  - jvs(18) * jvs(39)
+    jvs(40) = (jvs(40) + a) / jvs(27) 
+    a = 0.0; a = a  - jvs(19) * jvs(39) - jvs(28) * jvs(40)
+    jvs(41) = (jvs(41) + a) / jvs(34) 
+    jvs(42) = jvs(42) - jvs(9) * jvs(38) - jvs(29) * jvs(40) - jvs(35) * jvs(41)
+    jvs(43) = jvs(43) - jvs(20) * jvs(39) - jvs(30) * jvs(40) - jvs(36) * jvs(41)
+    jvs(44) = jvs(44) - jvs(37) * jvs(41)
+!   i = 12
+    jvs(45) = (jvs(45)) / jvs(14) 
+    jvs(46) = (jvs(46)) / jvs(17) 
+    jvs(47) = (jvs(47)) / jvs(22) 
+    a = 0.0; a = a  - jvs(18) * jvs(46) - jvs(23) * jvs(47)
+    jvs(48) = (jvs(48) + a) / jvs(27) 
+    a = 0.0; a = a  - jvs(19) * jvs(46) - jvs(28) * jvs(48)
+    jvs(49) = (jvs(49) + a) / jvs(34) 
+    a = 0.0; a = a  - jvs(24) * jvs(47) - jvs(29) * jvs(48) - jvs(35) * jvs(49)
+    jvs(50) = (jvs(50) + a) / jvs(42) 
+    jvs(51) = jvs(51) - jvs(15) * jvs(45) - jvs(20) * jvs(46) - jvs(25) * jvs(47) - jvs(30) * jvs(48)&
+          - jvs(36) * jvs(49) - jvs(43) * jvs(50)
+    jvs(52) = jvs(52) - jvs(16) * jvs(45) - jvs(26) * jvs(47) - jvs(37) * jvs(49) - jvs(44) * jvs(50)
+!   i = 13
+    jvs(53) = (jvs(53)) / jvs(10) 
+    jvs(54) = (jvs(54)) / jvs(14) 
+    jvs(55) = (jvs(55)) / jvs(17) 
+    a = 0.0; a = a  - jvs(11) * jvs(53)
+    jvs(56) = (jvs(56) + a) / jvs(22) 
+    a = 0.0; a = a  - jvs(18) * jvs(55) - jvs(23) * jvs(56)
+    jvs(57) = (jvs(57) + a) / jvs(27) 
+    a = 0.0; a = a  - jvs(19) * jvs(55) - jvs(28) * jvs(57)
+    jvs(58) = (jvs(58) + a) / jvs(34) 
+    a = 0.0; a = a  - jvs(24) * jvs(56) - jvs(29) * jvs(57) - jvs(35) * jvs(58)
+    jvs(59) = (jvs(59) + a) / jvs(42) 
+    a = 0.0; a = a  - jvs(15) * jvs(54) - jvs(20) * jvs(55) - jvs(25) * jvs(56) - jvs(30) * jvs(57)&
+          - jvs(36) * jvs(58) - jvs(43) * jvs(59)
+    jvs(60) = (jvs(60) + a) / jvs(51) 
+    jvs(61) = jvs(61) - jvs(12) * jvs(53) - jvs(16) * jvs(54) - jvs(26) * jvs(56) - jvs(37) * jvs(58)&
+          - jvs(44) * jvs(59) - jvs(52) * jvs(60)
+    RETURN                                                            
+                                                                      
+  END SUBROUTINE kppdecomp                                            
+ 
+SUBROUTINE chem_gasphase_integrate (time_step_len, conc, tempi, qvapi, fakti, photo, ierrf, xnacc, xnrej, istatus, l_debug, pe, &
+                     icntrl_i, rcntrl_i) 
+                                                                    
+  IMPLICIT NONE                                                     
+                                                                    
+  REAL(dp), INTENT(IN)                  :: time_step_len           
+  REAL(dp), DIMENSION(:, :), INTENT(INOUT) :: conc                    
+  REAL(dp), DIMENSION(:, :), INTENT(IN)   :: photo                   
+  REAL(dp), DIMENSION(:), INTENT(IN)     :: tempi                   
+  REAL(dp), DIMENSION(:), INTENT(IN)     :: qvapi                   
+  REAL(dp), DIMENSION(:), INTENT(IN)     :: fakti                   
+  INTEGER, INTENT(OUT), OPTIONAL        :: ierrf(:)               
+  INTEGER, INTENT(OUT), OPTIONAL        :: xnacc(:)               
+  INTEGER, INTENT(OUT), OPTIONAL        :: xnrej(:)               
+  INTEGER, INTENT(INOUT), OPTIONAL      :: istatus(:)             
+  INTEGER, INTENT(IN), OPTIONAL         :: pe                      
+  LOGICAL, INTENT(IN), OPTIONAL         :: l_debug                 
+  INTEGER, DIMENSION(nkppctrl), INTENT(IN), OPTIONAL  :: icntrl_i         
+  REAL(dp), DIMENSION(nkppctrl), INTENT(IN), OPTIONAL  :: rcntrl_i         
+                                                                    
+  INTEGER                                 :: k   ! loop variable     
+  REAL(dp)                               :: dt                      
+  INTEGER, DIMENSION(20)                :: istatus_u               
+  INTEGER                                :: ierr_u                  
+  INTEGER                                :: istatf                  
+  INTEGER                                :: vl_dim_lo               
+                                                                    
+                                                                    
+  IF (PRESENT (istatus)) istatus = 0                             
+  IF (PRESENT (icntrl_i)) icntrl  = icntrl_i                      
+  IF (PRESENT (rcntrl_i)) rcntrl  = rcntrl_i                      
+                                                                    
+  vl_glo = size(tempi, 1)                                           
+                                                                    
+  vl_dim_lo = vl_dim                                                
+  DO k=1, vl_glo, vl_dim_lo                                           
+    is = k                                                          
+    ie = min(k+ vl_dim_lo-1, vl_glo)                                 
+    vl = ie-is+ 1                                                    
+                                                                    
+    c(:) = conc(is, :)                                            
+                                                                    
+    temp = tempi(is)                                             
+                                                                    
+    qvap = qvapi(is)                                             
+                                                                    
+    fakt = fakti(is)                                             
+                                                                    
+    CALL initialize                                                 
+                                                                    
+    phot(:) = photo(is, :)                                            
+                                                                    
+    CALL update_rconst                                              
+                                                                    
+    dt = time_step_len                                              
+                                                                    
+    ! integrate from t=0 to t=dt                                    
+    CALL integrate(0._dp, dt, icntrl, rcntrl, istatus_u = istatus_u, ierr_u=ierr_u)
+                                                                    
+                                                                    
+   IF (PRESENT(l_debug) .AND. PRESENT(pe)) THEN                       
+      IF (l_debug) CALL error_output(conc(is, :), ierr_u, pe)          
+   ENDIF                                                              
+                                                                      
+    conc(is, :) = c(:)                                                
+                                                                    
+    ! RETURN diagnostic information                                 
+                                                                    
+    IF (PRESENT(ierrf))   ierrf(is) = ierr_u                      
+    IF (PRESENT(xnacc))   xnacc(is) = istatus_u(4)               
+    IF (PRESENT(xnrej))   xnrej(is) = istatus_u(5)               
+                                                                    
+    IF (PRESENT (istatus)) THEN                                   
+      istatus(1:8) = istatus(1:8) + istatus_u(1:8)                
+    ENDIF                                                          
+                                                                    
+  END DO                                                            
+ 
+                                                                    
+! Deallocate input arrays                                           
+                                                                    
+                                                                    
+  data_loaded = .FALSE.                                             
+                                                                    
+  RETURN                                                            
+END SUBROUTINE chem_gasphase_integrate                                        
+
+END MODULE chem_gasphase_mod
+ 
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_smog/chem_gasphase_mod.kpp
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_smog/chem_gasphase_mod.kpp	(revision 3297)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_smog/chem_gasphase_mod.kpp	(revision 3298)
@@ -1,3 +1,7 @@
 //chem_gasphase_mod.kpp
+//
+// Current revision
+// forkel 20.04.2018: added F90_INIT for initialization of fix compounds
+//
 //
 //Former revisions
@@ -11,7 +15,4 @@
 #HESSIAN    on
 #STOICMAT   on
-#INLINE F90_GLOBAL
-  !   Declaration of global variable declarations for photolysis will come from INLINE F90_DATA
-#ENDINLINE
 //
 // *******************************************************************************************
@@ -36,2 +37,7 @@
 #ENDINLINE
 
+#INLINE F90_INIT
+  fix(indf_h2o) = qvap
+  fix(indf_o2)  = 0.2e+6_dp *  fakt
+  fix(indf_co2) = 400.0_dp *  fakt
+#ENDINLINE
Index: palm/trunk/UTIL/chemistry/gasphase_preproc/run_kpp4palm.ksh
===================================================================
--- palm/trunk/UTIL/chemistry/gasphase_preproc/run_kpp4palm.ksh	(revision 3297)
+++ palm/trunk/UTIL/chemistry/gasphase_preproc/run_kpp4palm.ksh	(revision 3298)
@@ -29,4 +29,8 @@
 # -----------------
 # $Id$ 
+#  passed $MECH insted of $DEFDIR to kpp4palm.ksh                   forkel  25. Sept. 2018
+#  re-activaded  choice of deindexing method and vector mode        forkel  June 2018
+# 
+# 2718 2018-01-02 08:49:38Z maronga
 # Initial revision
 # 
@@ -72,12 +76,22 @@
 cd ..
 
-# run kpp4palm with default Setup
-#    -d   DEFDIR=$OPTARG;;          # directory of definition files
-#    -i   DE_INDEX="YES";;          # if set, deindexing
-#    -f   DE_INDEX_FAST="YES";;     # if set, fast deindexing
-#    -k   KEEP="NO";;               # keep Working directory
-#    -o   OUTDIR=$OPTARG;;          # Output directory of Geneated Code
-#    -p   PREFIX=$OPTARG;;          # Name Prefix
-#    -s   KPP_SOLVER=$OPTARG;;      # Name Prefix
+# run kpp4palm/bin/kpp4palm.ksh with the following Setup
+#    -d   DEFDIR=$OPTARG;;          # directory of definition files 
+#                                     (passed as `pwd`/mechanisms/def_$MECH)
+#    -m   MECH="smog";;             # chemical mechanism 
+#                                     (smog, simple, simplep, cbm4, phstat, passive, passive1)
+#    -i   DE_INDEX=2;;              # deindexing method (0,1,2,3; 0=no deindexing)
+#    -v   MODE="-v";;               # vector mode on (not working completely yet)
+#    -l   VLEN=$OPTARG;;            # Set vector length (not working completely yet)
+#    -k   KEEP="NO";;               # if "yes" keep Working directory
+#    -u   UPDT="NO";;               # if "yes" update the existing f90 code in the def_MECH directory
+#                                   # Use "YES" with care as the existing sample file is overwritten
+#
+##   Further options (not passed as changing does not make sense to change these)
+##    -f   DE_INDEX_FAST="YES";;     # if set, fast deindexing
+##    -o   OUTDIR=$OPTARG;;          # Output directory of Generated Code
+##                                     (`pwd`/../../../SOURCE)
+##    -p   PREFIX=$OPTARG;;          # Name Prefix (chem_gasphase_mod)
+##    -s   KPP_SOLVER=$OPTARG;;      # Name Prefix (rosenbrock)
 
  
@@ -85,17 +99,29 @@
 # use smog mechnism as default
 MECH=smog
+DEIN=2
 
-while  getopts m:k  opt   # get options
+while  getopts m:i:kuvl:  opt   # get options
 do case $opt in
       m)   MECH=$OPTARG;;          # mechanism name as part of mechanisms/def_[mechanism_name]
 
+      i)   DEIN=$OPTARG;;          # deindexing method (0,1,2,3; 0=no deindexing)
+
       k)   KEEP="-k";;             # keep Working directory
 
+      u)   UPDT="-u";;             # update sample output file
+
+      v)   MODE="-v";;             # vector mode on 
+
+      c)   COPY="-c";;             # copy output to def_MECH
+
+      l)   VLEN=$OPTARG;;          # Set vector length
+
       \?)  print ${0##*/} "unknown option:" $OPTARG
-           print "USAGE: ${0##*/} [ -m mechanism_name] [ -k] "
+           print "USAGE: ${0##*/} [ -m mechanism_name] [ -i n (n=0,1,2,3)] [ -k] [ -u] [ -v] [ -l N (N=vector length)]"
            exit 1;;
    esac
 done
-echo $MECH
+echo Now do kpp4palm for $MECH
 
-kpp4palm.ksh -d `pwd`/mechanisms/def_$MECH $KEEP
+# kpp4palm.ksh -d `pwd`/mechanisms/def_$MECH -i $DEIN $KEEP $UPDT $MODE -l $VLEN
+kpp4palm.ksh -m $MECH -i $DEIN $KEEP $UPDT $MODE -l $VLEN
