MODULE module_data_megan2
  IMPLICIT NONE
  INTEGER, PARAMETER :: n_mgn_spc = 20
  INTEGER, PARAMETER :: n_spc_char = 16
  CHARACTER (len=n_spc_char), DIMENSION (n_mgn_spc) :: mgn_spc
  INTEGER, PARAMETER :: &
       & imgn_isop = 1 &
       & ,imgn_mbo = 2 &
       & ,imgn_myrc = 3 &
       & ,imgn_sabi = 4 &
       & ,imgn_limo = 5 &
       & ,imgn_3car = 6 &
       & ,imgn_ocim = 7 &
       & ,imgn_bpin = 8 &
       & ,imgn_apin = 9 &
       & ,imgn_afarn = 10 &
       & ,imgn_bcar = 11 &
       & ,imgn_meoh = 12 &
       & ,imgn_acto = 13 &
       & ,imgn_acta = 14 &
       & ,imgn_form = 15 &
       & ,imgn_ch4 = 16 &
       & ,imgn_no = 17 &
       & ,imgn_omtp = 18 &
       & ,imgn_osqt = 19 &
       & ,imgn_co = 20
  DATA mgn_spc( imgn_isop ) / 'isoprene        ' /
  DATA mgn_spc( imgn_mbo ) / 'MBO             ' /
  DATA mgn_spc( imgn_myrc ) / 'myrcene         ' /
  DATA mgn_spc( imgn_sabi ) / 'sabinene        ' /
  DATA mgn_spc( imgn_limo ) / 'limonene        ' /
  DATA mgn_spc( imgn_3car ) / '3carene         ' /
  DATA mgn_spc( imgn_ocim ) / 'ocimene         ' /
  DATA mgn_spc( imgn_bpin ) / 'b-pinene        ' /
  DATA mgn_spc( imgn_apin ) / 'a-pininen       ' /
  DATA mgn_spc( imgn_afarn ) / 'a-farnescene    ' /
  DATA mgn_spc( imgn_bcar ) / 'b-caryophyllene ' /
  DATA mgn_spc( imgn_meoh ) / 'methanol        ' /
  DATA mgn_spc( imgn_acto ) / 'actone          ' /
  DATA mgn_spc( imgn_acta ) / 'acta            ' /
  DATA mgn_spc( imgn_form ) / 'form            ' /
  DATA mgn_spc( imgn_ch4 ) / 'methane         ' /
  DATA mgn_spc( imgn_no ) / 'NO              ' /
  DATA mgn_spc( imgn_omtp ) / 'other_monoterp  ' /
  DATA mgn_spc( imgn_osqt ) / 'other_sesquiterp' /
  DATA mgn_spc( imgn_co ) / 'CO              ' /
  REAL , DIMENSION(n_mgn_spc) :: tdf_prm
  DATA tdf_prm ( imgn_isop ) / 0.09 /
  DATA tdf_prm ( imgn_mbo ) / 0.09 /
  DATA tdf_prm ( imgn_myrc ) / 0.10 /
  DATA tdf_prm ( imgn_sabi ) / 0.10 /
  DATA tdf_prm ( imgn_limo ) / 0.10 /
  DATA tdf_prm ( imgn_3car ) / 0.10 /
  DATA tdf_prm ( imgn_ocim ) / 0.10 /
  DATA tdf_prm ( imgn_bpin ) / 0.10 /
  DATA tdf_prm ( imgn_apin ) / 0.10 /
  DATA tdf_prm ( imgn_afarn ) / 0.17 /
  DATA tdf_prm ( imgn_bcar ) / 0.17 /
  DATA tdf_prm ( imgn_meoh ) / 0.08 /
  DATA tdf_prm ( imgn_acto ) / 0.11 /
  DATA tdf_prm ( imgn_acta ) / 0.13 /
  DATA tdf_prm ( imgn_form ) / 0.09 /
  DATA tdf_prm ( imgn_ch4 ) / 0.05 /
  DATA tdf_prm ( imgn_no ) / 0.11 /
  DATA tdf_prm ( imgn_omtp ) / 0.10 /
  DATA tdf_prm ( imgn_osqt ) / 0.17 /
  DATA tdf_prm ( imgn_co ) / 0.09 /
  REAL , DIMENSION(n_mgn_spc) :: ldf_fct
  DATA ldf_fct ( imgn_isop ) / 0.9999 /
  DATA ldf_fct ( imgn_mbo ) / 0.9999 /
  DATA ldf_fct ( imgn_myrc ) / 0.05 /
  DATA ldf_fct ( imgn_sabi ) / 0.10 /
  DATA ldf_fct ( imgn_limo ) / 0.05 /
  DATA ldf_fct ( imgn_3car ) / 0.05 /
  DATA ldf_fct ( imgn_ocim ) / 0.80 /
  DATA ldf_fct ( imgn_bpin ) / 0.10 /
  DATA ldf_fct ( imgn_apin ) / 0.10 /
  DATA ldf_fct ( imgn_afarn ) / 0.50 /
  DATA ldf_fct ( imgn_bcar ) / 0.50 /
  DATA ldf_fct ( imgn_meoh ) / 0.75 /
  DATA ldf_fct ( imgn_acto ) / 0.25 /
  DATA ldf_fct ( imgn_acta ) / 0.50 /
  DATA ldf_fct ( imgn_form ) / 0.50 /
  DATA ldf_fct ( imgn_ch4 ) / 0.75 /
  DATA ldf_fct ( imgn_no ) / 0.00 /
  DATA ldf_fct ( imgn_omtp ) / 0.10 /
  DATA ldf_fct ( imgn_osqt ) / 0.50 /
  DATA ldf_fct ( imgn_co ) / 0.50 /
  REAL , DIMENSION(n_mgn_spc) :: rho_fct
  DATA rho_fct ( imgn_isop ) / 1.0 /
  DATA rho_fct ( imgn_mbo ) / 1.0 /
  DATA rho_fct ( imgn_myrc ) / 1.0 /
  DATA rho_fct ( imgn_sabi ) / 1.0 /
  DATA rho_fct ( imgn_limo ) / 1.0 /
  DATA rho_fct ( imgn_3car ) / 1.0 /
  DATA rho_fct ( imgn_ocim ) / 1.0 /
  DATA rho_fct ( imgn_bpin ) / 1.0 /
  DATA rho_fct ( imgn_apin ) / 1.0 /
  DATA rho_fct ( imgn_afarn ) / 1.0 /
  DATA rho_fct ( imgn_bcar ) / 1.0 /
  DATA rho_fct ( imgn_meoh ) / 1.0 /
  DATA rho_fct ( imgn_acto ) / 1.0 /
  DATA rho_fct ( imgn_acta ) / 1.0 /
  DATA rho_fct ( imgn_form ) / 1.0 /
  DATA rho_fct ( imgn_ch4 ) / 1.0 /
  DATA rho_fct ( imgn_no ) / 1.0 /
  DATA rho_fct ( imgn_omtp ) / 1.0 /
  DATA rho_fct ( imgn_osqt ) / 1.0 /
  DATA rho_fct ( imgn_co ) / 1.0 /
  INTEGER, PARAMETER :: n_cat=5
  REAL, DIMENSION(n_cat) :: anew, agro, amat, aold
  DATA anew (1) , agro (1) , amat (1) , aold (1) / 1.0 , 1.0 , 1.0 , 1.0 /
  DATA anew (2) , agro (2) , amat (2) , aold (2) / 2.0 , 1.8 , 0.95 , 1.0 /
  DATA anew (3) , agro (3) , amat (3) , aold (3) / 0.4 , 0.6 , 1.075 , 1.0 /
  DATA anew (4) , agro (4) , amat (4) , aold (4) / 3.0 , 2.6 , 0.85 , 1.0 /
  DATA anew (5) , agro (5) , amat (5) , aold (5) / 0.05 , 0.6 , 1.125 , 1.0 /
  INTEGER, PARAMETER :: n_pft = 4
  REAL, DIMENSION (n_mgn_spc,n_pft) :: EF
  INTEGER, PARAMETER :: k_bt = 1, k_nt = 2, k_sb=3, k_hb=4
  DATA EF( imgn_isop , 1:n_pft ) / 13000.00 , 2000.00 , 11000.00 , 400.00 /
  DATA EF( imgn_mbo , 1:n_pft ) / 0.10 , 100.00 , 1.00 , 0.01 /
  DATA EF( imgn_myrc , 1:n_pft ) / 20.00 , 75.00 , 22.00 , 0.30 /
  DATA EF( imgn_sabi , 1:n_pft ) / 45.00 , 70.00 , 50.00 , 0.70 /
  DATA EF( imgn_limo , 1:n_pft ) / 45.00 , 100.00 , 52.00 , 0.70 /
  DATA EF( imgn_3car , 1:n_pft ) / 18.00 , 160.00 , 25.00 , 0.30 /
  DATA EF( imgn_ocim , 1:n_pft ) / 90.00 , 60.00 , 85.00 , 1.00 /
  DATA EF( imgn_bpin , 1:n_pft ) / 90.00 , 300.00 , 100.00 , 1.50 /
  DATA EF( imgn_apin , 1:n_pft ) / 180.00 , 450.00 , 200.00 , 2.00 /
  DATA EF( imgn_afarn , 1:n_pft ) / 35.00 , 30.00 , 30.00 , 0.50 /
  DATA EF( imgn_bcar , 1:n_pft ) / 30.00 , 60.00 , 45.00 , 0.90 /
  DATA EF( imgn_meoh , 1:n_pft ) / 800.00 , 800.00 , 800.00 , 800.00 /
  DATA EF( imgn_acto , 1:n_pft ) / 240.00 , 240.00 , 240.00 , 80.00 /
  DATA EF( imgn_acta , 1:n_pft ) / 240.00 , 240.00 , 240.00 , 80.00 /
  DATA EF( imgn_form , 1:n_pft ) / 70.00 , 70.00 , 70.00 , 70.00 /
  DATA EF( imgn_ch4 , 1:n_pft ) / 30.00 , 30.00 , 30.00 , 30.00 /
  DATA EF( imgn_no , 1:n_pft ) / 5.00 , 6.00 , 30.00 , 70.00 /
  DATA EF( imgn_omtp , 1:n_pft ) / 90.00 , 180.00 , 110.00 , 4.80 /
  DATA EF( imgn_osqt , 1:n_pft ) / 75.00 , 110.00 , 85.00 , 1.40 /
  DATA EF( imgn_co , 1:n_pft ) / 1000.00 , 1000.00 , 1000.00 , 1000.00 /
  INTEGER, PARAMETER :: n_spca_spc = 138
  CHARACTER(len=n_spc_char), DIMENSION(n_spca_spc) :: spca_spc
  REAL , DIMENSION(n_spca_spc) :: spca_mwt
  INTEGER, PARAMETER :: &
       & is_isoprene = 1 &
       & ,is_myrcene = 2 &
       & ,is_sabinene = 3 &
       & ,is_limonene = 4 &
       & ,is_carene_3 = 5 &
       & ,is_ocimene_t_b = 6 &
       & ,is_pinene_b = 7 &
       & ,is_pinene_a = 8 &
       & ,is_2met_styrene = 9 &
       & ,is_cymene_p = 10 &
       & ,is_cymene_o = 11 &
       & ,is_phellandrene_a = 12 &
       & ,is_thujene_a = 13 &
       & ,is_terpinene_a = 14 &
       & ,is_terpinene_g = 15 &
       & ,is_terpinolene = 16 &
       & ,is_phellandrene_b = 17 &
       & ,is_camphene = 18 &
       & ,is_bornene = 19 &
       & ,is_fenchene_a = 20 &
       & ,is_ocimene_al = 21 &
       & ,is_ocimene_c_b = 22 &
       & ,is_tricyclene = 23 &
       & ,is_estragole = 24 &
       & ,is_camphor = 25 &
       & ,is_fenchone = 26 &
       & ,is_piperitone = 27 &
       & ,is_thujone_a = 28 &
       & ,is_thujone_b = 29 &
       & ,is_cineole_1_8 = 30 &
       & ,is_borneol = 31 &
       & ,is_linalool = 32 &
       & ,is_terpineol_4 = 33 &
       & ,is_terpineol_a = 34 &
       & ,is_linalool_OXD_c = 35 &
       & ,is_linalool_OXD_t = 36 &
       & ,is_ionone_b = 37 &
       & ,is_bornyl_ACT = 38 &
       & ,is_farnescene_a = 39 &
       & ,is_caryophyllene_b = 40 &
       & ,is_acoradiene = 41 &
       & ,is_aromadendrene = 42 &
       & ,is_bergamotene_a = 43 &
       & ,is_bergamotene_b = 44 &
       & ,is_bisabolene_a = 45 &
       & ,is_bisabolene_b = 46 &
       & ,is_bourbonene_b = 47 &
       & ,is_cadinene_d = 48 &
       & ,is_cadinene_g = 49 &
       & ,is_cedrene_a = 50 &
       & ,is_copaene_a = 51 &
       & ,is_cubebene_a = 52 &
       & ,is_cubebene_b = 53 &
       & ,is_elemene_b = 54 &
       & ,is_farnescene_b = 55 &
       & ,is_germacrene_B = 56 &
       & ,is_germacrene_D = 57 &
       & ,is_gurjunene_b = 58 &
       & ,is_humulene_a = 59 &
       & ,is_humulene_g = 60 &
       & ,is_isolongifolene = 61 &
       & ,is_longifolene = 62 &
       & ,is_longipinene = 63 &
       & ,is_muurolene_a = 64 &
       & ,is_muurolene_g = 65 &
       & ,is_selinene_b = 66 &
       & ,is_selinene_d = 67 &
       & ,is_nerolidol_c = 68 &
       & ,is_nerolidol_t = 69 &
       & ,is_cedrol = 70 &
       & ,is_MBO_2m3e2ol = 71 &
       & ,is_methanol = 72 &
       & ,is_acetone = 73 &
       & ,is_methane = 74 &
       & ,is_ammonia = 75 &
       & ,is_nitrous_OXD = 76 &
       & ,is_nitric_OXD = 77 &
       & ,is_acetaldehyde = 78 &
       & ,is_ethanol = 79 &
       & ,is_formic_acid = 80 &
       & ,is_formaldehyde = 81 &
       & ,is_acetic_acid = 82 &
       & ,is_MBO_3m2e1ol = 83 &
       & ,is_MBO_3m3e1ol = 84 &
       & ,is_benzaldehyde = 85 &
       & ,is_butanone_2 = 86 &
       & ,is_decanal = 87 &
       & ,is_dodecene_1 = 88 &
       & ,is_geranyl_acetone = 89 &
       & ,is_heptanal = 90 &
       & ,is_heptane = 91 &
       & ,is_hexane = 92 &
       & ,is_met_benzoate = 93 &
       & ,is_met_heptenone = 94 &
       & ,is_neryl_acetone = 95 &
       & ,is_nonanal = 96 &
       & ,is_nonenal = 97 &
       & ,is_octanal = 98 &
       & ,is_octanol = 99 &
       & ,is_octenol_1e3ol = 100 &
       & ,is_oxopentanal = 101 &
       & ,is_pentane = 102 &
       & ,is_phenyl_CCO = 103 &
       & ,is_pyruvic_acid = 104 &
       & ,is_terpinyl_ACT_a = 105 &
       & ,is_tetradecene_1 = 106 &
       & ,is_toluene = 107 &
       & ,is_carbon_monoxide = 108 &
       & ,is_butene = 109 &
       & ,is_ethane = 110 &
       & ,is_ethene = 111 &
       & ,is_hydrogen_cyanide = 112 &
       & ,is_propane = 113 &
       & ,is_propene = 114 &
       & ,is_carbon_2s = 115 &
       & ,is_carbonyl_s = 116 &
       & ,is_diallyl_2s = 117 &
       & ,is_2met_2s = 118 &
       & ,is_2met_s = 119 &
       & ,is_met_chloride = 120 &
       & ,is_met_bromide = 121 &
       & ,is_met_iodide = 122 &
       & ,is_hydrogen_s = 123 &
       & ,is_met_mercaptan = 124 &
       & ,is_met_propenyl_2s = 125 &
       & ,is_PPPP_2s = 126 &
       & ,is_2met_nonatriene = 127 &
       & ,is_met_salicylate = 128 &
       & ,is_indole = 129 &
       & ,is_jasmone = 130 &
       & ,is_met_jasmonate = 131 &
       & ,is_3met_3DCTT = 132 &
       & ,is_hexanal = 133 &
       & ,is_hexanol_1 = 134 &
       & ,is_hexenal_c3 = 135 &
       & ,is_hexenal_t2 = 136 &
       & ,is_hexenol_c3 = 137 &
       & ,is_hexenyl_ACT_c3 = 138
  DATA spca_spc(is_isoprene ), spca_mwt(is_isoprene ) / 'isoprene        ' , 68.12 /
  DATA spca_spc(is_myrcene ), spca_mwt(is_myrcene ) / 'myrcene         ' , 136.23 /
  DATA spca_spc(is_sabinene ), spca_mwt(is_sabinene ) / 'sabinene        ' , 136.23 /
  DATA spca_spc(is_limonene ), spca_mwt(is_limonene ) / 'limonene        ' , 136.23 /
  DATA spca_spc(is_carene_3 ), spca_mwt(is_carene_3 ) / 'carene_3        ' , 136.23 /
  DATA spca_spc(is_ocimene_t_b ), spca_mwt(is_ocimene_t_b ) / 'ocimene_t_b     ' , 136.23 /
  DATA spca_spc(is_pinene_b ), spca_mwt(is_pinene_b ) / 'pinene_b        ' , 136.23 /
  DATA spca_spc(is_pinene_a ), spca_mwt(is_pinene_a ) / 'pinene_a        ' , 136.23 /
  DATA spca_spc(is_2met_styrene ), spca_mwt(is_2met_styrene ) / '2met_styrene    ' , 132.20 /
  DATA spca_spc(is_cymene_p ), spca_mwt(is_cymene_p ) / 'cymene_p        ' , 134.22 /
  DATA spca_spc(is_cymene_o ), spca_mwt(is_cymene_o ) / 'cymene_o        ' , 134.22 /
  DATA spca_spc(is_phellandrene_a ), spca_mwt(is_phellandrene_a ) / 'phellandrene_a  ' , 136.23 /
  DATA spca_spc(is_thujene_a ), spca_mwt(is_thujene_a ) / 'thujene_a       ' , 136.23 /
  DATA spca_spc(is_terpinene_a ), spca_mwt(is_terpinene_a ) / 'terpinene_a     ' , 136.23 /
  DATA spca_spc(is_terpinene_g ), spca_mwt(is_terpinene_g ) / 'terpinene_g     ' , 136.23 /
  DATA spca_spc(is_terpinolene ), spca_mwt(is_terpinolene ) / 'terpinolene     ' , 136.23 /
  DATA spca_spc(is_phellandrene_b ), spca_mwt(is_phellandrene_b ) / 'phellandrene_b  ' , 136.23 /
  DATA spca_spc(is_camphene ), spca_mwt(is_camphene ) / 'camphene        ' , 136.23 /
  DATA spca_spc(is_bornene ), spca_mwt(is_bornene ) / 'bornene         ' , 136.23 /
  DATA spca_spc(is_fenchene_a ), spca_mwt(is_fenchene_a ) / 'fenchene_a      ' , 136.23 /
  DATA spca_spc(is_ocimene_al ), spca_mwt(is_ocimene_al ) / 'ocimene_al      ' , 136.23 /
  DATA spca_spc(is_ocimene_c_b ), spca_mwt(is_ocimene_c_b ) / 'ocimene_c_b     ' , 136.23 /
  DATA spca_spc(is_tricyclene ), spca_mwt(is_tricyclene ) / 'tricyclene      ' , 136.23 /
  DATA spca_spc(is_estragole ), spca_mwt(is_estragole ) / 'estragole       ' , 148.20 /
  DATA spca_spc(is_camphor ), spca_mwt(is_camphor ) / 'camphor         ' , 152.23 /
  DATA spca_spc(is_fenchone ), spca_mwt(is_fenchone ) / 'fenchone        ' , 152.23 /
  DATA spca_spc(is_piperitone ), spca_mwt(is_piperitone ) / 'piperitone      ' , 152.23 /
  DATA spca_spc(is_thujone_a ), spca_mwt(is_thujone_a ) / 'thujone_a       ' , 152.23 /
  DATA spca_spc(is_thujone_b ), spca_mwt(is_thujone_b ) / 'thujone_b       ' , 152.23 /
  DATA spca_spc(is_cineole_1_8 ), spca_mwt(is_cineole_1_8 ) / 'cineole_1_8     ' , 154.25 /
  DATA spca_spc(is_borneol ), spca_mwt(is_borneol ) / 'borneol         ' , 154.25 /
  DATA spca_spc(is_linalool ), spca_mwt(is_linalool ) / 'linalool        ' , 154.25 /
  DATA spca_spc(is_terpineol_4 ), spca_mwt(is_terpineol_4 ) / 'terpineol_4     ' , 154.25 /
  DATA spca_spc(is_terpineol_a ), spca_mwt(is_terpineol_a ) / 'terpineol_a     ' , 154.25 /
  DATA spca_spc(is_linalool_oxd_c ), spca_mwt(is_linalool_oxd_c ) / 'linalool_oxd_c  ' , 170.25 /
  DATA spca_spc(is_linalool_oxd_t ), spca_mwt(is_linalool_oxd_t ) / 'linalool_oxd_t  ' , 170.25 /
  DATA spca_spc(is_ionone_b ), spca_mwt(is_ionone_b ) / 'ionone_b        ' , 192.30 /
  DATA spca_spc(is_bornyl_act ), spca_mwt(is_bornyl_act ) / 'bornyl_act      ' , 196.29 /
  DATA spca_spc(is_farnescene_a ), spca_mwt(is_farnescene_a ) / 'farnescene_a    ' , 204.35 /
  DATA spca_spc(is_caryophyllene_b ), spca_mwt(is_caryophyllene_b ) / 'caryophyllene_b ' , 204.35 /
  DATA spca_spc(is_acoradiene ), spca_mwt(is_acoradiene ) / 'acoradiene      ' , 204.35 /
  DATA spca_spc(is_aromadendrene ), spca_mwt(is_aromadendrene ) / 'aromadendrene   ' , 204.35 /
  DATA spca_spc(is_bergamotene_a ), spca_mwt(is_bergamotene_a ) / 'bergamotene_a   ' , 204.35 /
  DATA spca_spc(is_bergamotene_b ), spca_mwt(is_bergamotene_b ) / 'bergamotene_b   ' , 204.35 /
  DATA spca_spc(is_bisabolene_a ), spca_mwt(is_bisabolene_a ) / 'bisabolene_a    ' , 204.35 /
  DATA spca_spc(is_bisabolene_b ), spca_mwt(is_bisabolene_b ) / 'bisabolene_b    ' , 204.35 /
  DATA spca_spc(is_bourbonene_b ), spca_mwt(is_bourbonene_b ) / 'bourbonene_b    ' , 204.35 /
  DATA spca_spc(is_cadinene_d ), spca_mwt(is_cadinene_d ) / 'cadinene_d      ' , 204.35 /
  DATA spca_spc(is_cadinene_g ), spca_mwt(is_cadinene_g ) / 'cadinene_g      ' , 204.35 /
  DATA spca_spc(is_cedrene_a ), spca_mwt(is_cedrene_a ) / 'cedrene_a       ' , 204.35 /
  DATA spca_spc(is_copaene_a ), spca_mwt(is_copaene_a ) / 'copaene_a       ' , 204.35 /
  DATA spca_spc(is_cubebene_a ), spca_mwt(is_cubebene_a ) / 'cubebene_a      ' , 204.35 /
  DATA spca_spc(is_cubebene_b ), spca_mwt(is_cubebene_b ) / 'cubebene_b      ' , 204.35 /
  DATA spca_spc(is_elemene_b ), spca_mwt(is_elemene_b ) / 'elemene_b       ' , 204.35 /
  DATA spca_spc(is_farnescene_b ), spca_mwt(is_farnescene_b ) / 'farnescene_b    ' , 204.35 /
  DATA spca_spc(is_germacrene_b ), spca_mwt(is_germacrene_B ) / 'germacrene_b    ' , 204.35 /
  DATA spca_spc(is_germacrene_d ), spca_mwt(is_germacrene_D ) / 'germacrene_d    ' , 204.35 /
  DATA spca_spc(is_gurjunene_b ), spca_mwt(is_gurjunene_b ) / 'gurjunene_b     ' , 204.35 /
  DATA spca_spc(is_humulene_a ), spca_mwt(is_humulene_a ) / 'humulene_a      ' , 204.35 /
  DATA spca_spc(is_humulene_g ), spca_mwt(is_humulene_g ) / 'humulene_g      ' , 204.35 /
  DATA spca_spc(is_isolongifolene ), spca_mwt(is_isolongifolene ) / 'isolongifolene  ' , 204.35 /
  DATA spca_spc(is_longifolene ), spca_mwt(is_longifolene ) / 'longifolene     ' , 204.35 /
  DATA spca_spc(is_longipinene ), spca_mwt(is_longipinene ) / 'longipinene     ' , 204.35 /
  DATA spca_spc(is_muurolene_a ), spca_mwt(is_muurolene_a ) / 'muurolene_a     ' , 204.35 /
  DATA spca_spc(is_muurolene_g ), spca_mwt(is_muurolene_g ) / 'muurolene_g     ' , 204.35 /
  DATA spca_spc(is_selinene_b ), spca_mwt(is_selinene_b ) / 'selinene_b      ' , 204.35 /
  DATA spca_spc(is_selinene_d ), spca_mwt(is_selinene_d ) / 'selinene_d      ' , 204.35 /
  DATA spca_spc(is_nerolidol_c ), spca_mwt(is_nerolidol_c ) / 'nerolidol_c     ' , 222.37 /
  DATA spca_spc(is_nerolidol_t ), spca_mwt(is_nerolidol_t ) / 'nerolidol_t     ' , 222.37 /
  DATA spca_spc(is_cedrol ), spca_mwt(is_cedrol ) / 'cedrol          ' , 222.37 /
  DATA spca_spc(is_mbo_2m3e2ol ), spca_mwt(is_mbo_2m3e2ol ) / 'mbo_2m3e2ol     ' , 86.13 /
  DATA spca_spc(is_methanol ), spca_mwt(is_methanol ) / 'methanol        ' , 32.04 /
  DATA spca_spc(is_acetone ), spca_mwt(is_acetone ) / 'acetone         ' , 58.08 /
  DATA spca_spc(is_methane ), spca_mwt(is_methane ) / 'methane         ' , 16.04 /
  DATA spca_spc(is_ammonia ), spca_mwt(is_ammonia ) / 'ammonia         ' , 17.03 /
  DATA spca_spc(is_nitrous_oxd ), spca_mwt(is_nitrous_oxd ) / 'nitrous_oxd     ' , 44.01 /
  DATA spca_spc(is_nitric_oxd ), spca_mwt(is_nitric_oxd ) / 'nitric_oxd      ' , 30.01 /
  DATA spca_spc(is_acetaldehyde ), spca_mwt(is_acetaldehyde ) / 'acetaldehyde    ' , 44.05 /
  DATA spca_spc(is_ethanol ), spca_mwt(is_ethanol ) / 'ethanol         ' , 46.07 /
  DATA spca_spc(is_formic_acid ), spca_mwt(is_formic_acid ) / 'formic_acid     ' , 46.03 /
  DATA spca_spc(is_formaldehyde ), spca_mwt(is_formaldehyde ) / 'formaldehyde    ' , 30.03 /
  DATA spca_spc(is_acetic_acid ), spca_mwt(is_acetic_acid ) / 'acetic_acid     ' , 60.05 /
  DATA spca_spc(is_mbo_3m2e1ol ), spca_mwt(is_mbo_3m2e1ol ) / 'mbo_3m2e1ol     ' , 86.13 /
  DATA spca_spc(is_mbo_3m3e1ol ), spca_mwt(is_mbo_3m3e1ol ) / 'mbo_3m3e1ol     ' , 86.13 /
  DATA spca_spc(is_benzaldehyde ), spca_mwt(is_benzaldehyde ) / 'benzaldehyde    ' , 106.12 /
  DATA spca_spc(is_butanone_2 ), spca_mwt(is_butanone_2 ) / 'butanone_2      ' , 72.11 /
  DATA spca_spc(is_decanal ), spca_mwt(is_decanal ) / 'decanal         ' , 156.27 /
  DATA spca_spc(is_dodecene_1 ), spca_mwt(is_dodecene_1 ) / 'dodecene_1      ' , 168.32 /
  DATA spca_spc(is_geranyl_acetone ), spca_mwt(is_geranyl_acetone ) / 'geranyl_acetone ' , 194.31 /
  DATA spca_spc(is_heptanal ), spca_mwt(is_heptanal ) / 'heptanal        ' , 114.19 /
  DATA spca_spc(is_heptane ), spca_mwt(is_heptane ) / 'heptane         ' , 100.20 /
  DATA spca_spc(is_hexane ), spca_mwt(is_hexane ) / 'hexane          ' , 86.18 /
  DATA spca_spc(is_met_benzoate ), spca_mwt(is_met_benzoate ) / 'met_benzoate    ' , 136.15 /
  DATA spca_spc(is_met_heptenone ), spca_mwt(is_met_heptenone ) / 'met_heptenone   ' , 126.20 /
  DATA spca_spc(is_neryl_acetone ), spca_mwt(is_neryl_acetone ) / 'neryl_acetone   ' , 194.31 /
  DATA spca_spc(is_nonanal ), spca_mwt(is_nonanal ) / 'nonanal         ' , 142.24 /
  DATA spca_spc(is_nonenal ), spca_mwt(is_nonenal ) / 'nonenal         ' , 140.22 /
  DATA spca_spc(is_octanal ), spca_mwt(is_octanal ) / 'octanal         ' , 128.21 /
  DATA spca_spc(is_octanol ), spca_mwt(is_octanol ) / 'octanol         ' , 130.23 /
  DATA spca_spc(is_octenol_1e3ol ), spca_mwt(is_octenol_1e3ol ) / 'octenol_1e3ol   ' , 128.21 /
  DATA spca_spc(is_oxopentanal ), spca_mwt(is_oxopentanal ) / 'oxopentanal     ' , 100.12 /
  DATA spca_spc(is_pentane ), spca_mwt(is_pentane ) / 'pentane         ' , 72.15 /
  DATA spca_spc(is_phenyl_cco ), spca_mwt(is_phenyl_cco ) / 'phenyl_cco      ' , 120.15 /
  DATA spca_spc(is_pyruvic_acid ), spca_mwt(is_pyruvic_acid ) / 'pyruvic_acid    ' , 88.06 /
  DATA spca_spc(is_terpinyl_act_a ), spca_mwt(is_terpinyl_act_a ) / 'terpinyl_act_a  ' , 196.29 /
  DATA spca_spc(is_tetradecene_1 ), spca_mwt(is_tetradecene_1 ) / 'tetradecene_1   ' , 196.37 /
  DATA spca_spc(is_toluene ), spca_mwt(is_toluene ) / 'toluene         ' , 92.14 /
  DATA spca_spc(is_carbon_monoxide ), spca_mwt(is_carbon_monoxide ) / 'carbon_monoxide ' , 28.01 /
  DATA spca_spc(is_butene ), spca_mwt(is_butene ) / 'butene          ' , 56.11 /
  DATA spca_spc(is_ethane ), spca_mwt(is_ethane ) / 'ethane          ' , 30.07 /
  DATA spca_spc(is_ethene ), spca_mwt(is_ethene ) / 'ethene          ' , 28.05 /
  DATA spca_spc(is_hydrogen_cyanide), spca_mwt(is_hydrogen_cyanide) / 'hydrogen_cyanide' , 27.03 /
  DATA spca_spc(is_propane ), spca_mwt(is_propane ) / 'propane         ' , 44.10 /
  DATA spca_spc(is_propene ), spca_mwt(is_propene ) / 'propene         ' , 42.08 /
  DATA spca_spc(is_carbon_2s ), spca_mwt(is_carbon_2s ) / 'carbon_2s       ' , 76.14 /
  DATA spca_spc(is_carbonyl_s ), spca_mwt(is_carbonyl_s ) / 'carbonyl_s      ' , 60.08 /
  DATA spca_spc(is_diallyl_2s ), spca_mwt(is_diallyl_2s ) / 'diallyl_2s      ' , 146.28 /
  DATA spca_spc(is_2met_2s ), spca_mwt(is_2met_2s ) / '2met_2s         ' , 94.20 /
  DATA spca_spc(is_2met_s ), spca_mwt(is_2met_s ) / '2met_s          ' , 62.14 /
  DATA spca_spc(is_met_chloride ), spca_mwt(is_met_chloride ) / 'met_chloride    ' , 50.49 /
  DATA spca_spc(is_met_bromide ), spca_mwt(is_met_bromide ) / 'met_bromide     ' , 94.94 /
  DATA spca_spc(is_met_iodide ), spca_mwt(is_met_iodide ) / 'met_iodide      ' , 141.94 /
  DATA spca_spc(is_hydrogen_s ), spca_mwt(is_hydrogen_s ) / 'hydrogen_s      ' , 34.08 /
  DATA spca_spc(is_met_mercaptan ), spca_mwt(is_met_mercaptan ) / 'met_mercaptan   ' , 48.11 /
  DATA spca_spc(is_met_propenyl_2s ), spca_mwt(is_met_propenyl_2s ) / 'met_propenyl_2s ' , 120.24 /
  DATA spca_spc(is_pppp_2s ), spca_mwt(is_pppp_2s ) / 'pppp_2s         ' , 148.29 /
  DATA spca_spc(is_2met_nonatriene ), spca_mwt(is_2met_nonatriene ) / '2met_nonatriene ' , 150.26 /
  DATA spca_spc(is_met_salicylate ), spca_mwt(is_met_salicylate ) / 'met_salicylate  ' , 152.15 /
  DATA spca_spc(is_indole ), spca_mwt(is_indole ) / 'indole          ' , 117.15 /
  DATA spca_spc(is_jasmone ), spca_mwt(is_jasmone ) / 'jasmone         ' , 164.24 /
  DATA spca_spc(is_met_jasmonate ), spca_mwt(is_met_jasmonate ) / 'met_jasmonate   ' , 224.30 /
  DATA spca_spc(is_3met_3dctt ), spca_mwt(is_3met_3dctt ) / '3met_3dctt      ' , 218.38 /
  DATA spca_spc(is_hexanal ), spca_mwt(is_hexanal ) / 'hexanal         ' , 100.16 /
  DATA spca_spc(is_hexanol_1 ), spca_mwt(is_hexanol_1 ) / 'hexanol_1       ' , 102.17 /
  DATA spca_spc(is_hexenal_c3 ), spca_mwt(is_hexenal_c3 ) / 'hexenal_c3      ' , 98.14 /
  DATA spca_spc(is_hexenal_t2 ), spca_mwt(is_hexenal_t2 ) / 'hexenal_t2      ' , 98.14 /
  DATA spca_spc(is_hexenol_c3 ), spca_mwt(is_hexenol_c3 ) / 'hexenol_c3      ' , 100.16 /
  DATA spca_spc(is_hexenyl_act_c3 ), spca_mwt(is_hexenyl_act_c3 ) / 'hexenyl_act_c3  ' , 142.20 /
  INTEGER, DIMENSION(n_spca_spc) :: mg20_map
  DATA mg20_map ( is_isoprene ) / imgn_isop /
  DATA mg20_map ( is_myrcene ) / imgn_myrc /
  DATA mg20_map ( is_sabinene ) / imgn_sabi /
  DATA mg20_map ( is_limonene ) / imgn_limo /
  DATA mg20_map ( is_carene_3 ) / imgn_3car /
  DATA mg20_map ( is_ocimene_t_b ) / imgn_ocim /
  DATA mg20_map ( is_pinene_b ) / imgn_bpin /
  DATA mg20_map ( is_pinene_a ) / imgn_apin /
  DATA mg20_map ( is_2met_styrene ) / imgn_omtp /
  DATA mg20_map ( is_cymene_p ) / imgn_omtp /
  DATA mg20_map ( is_cymene_o ) / imgn_omtp /
  DATA mg20_map ( is_phellandrene_a ) / imgn_omtp /
  DATA mg20_map ( is_thujene_a ) / imgn_omtp /
  DATA mg20_map ( is_terpinene_a ) / imgn_omtp /
  DATA mg20_map ( is_terpinene_g ) / imgn_omtp /
  DATA mg20_map ( is_terpinolene ) / imgn_omtp /
  DATA mg20_map ( is_phellandrene_b ) / imgn_omtp /
  DATA mg20_map ( is_camphene ) / imgn_omtp /
  DATA mg20_map ( is_bornene ) / imgn_omtp /
  DATA mg20_map ( is_fenchene_a ) / imgn_omtp /
  DATA mg20_map ( is_ocimene_al ) / imgn_omtp /
  DATA mg20_map ( is_ocimene_c_b ) / imgn_omtp /
  DATA mg20_map ( is_tricyclene ) / imgn_omtp /
  DATA mg20_map ( is_estragole ) / imgn_omtp /
  DATA mg20_map ( is_camphor ) / imgn_omtp /
  DATA mg20_map ( is_fenchone ) / imgn_omtp /
  DATA mg20_map ( is_piperitone ) / imgn_omtp /
  DATA mg20_map ( is_thujone_a ) / imgn_omtp /
  DATA mg20_map ( is_thujone_b ) / imgn_omtp /
  DATA mg20_map ( is_cineole_1_8 ) / imgn_omtp /
  DATA mg20_map ( is_borneol ) / imgn_omtp /
  DATA mg20_map ( is_linalool ) / imgn_omtp /
  DATA mg20_map ( is_terpineol_4 ) / imgn_omtp /
  DATA mg20_map ( is_terpineol_a ) / imgn_omtp /
  DATA mg20_map ( is_linalool_oxd_c ) / imgn_omtp /
  DATA mg20_map ( is_linalool_oxd_t ) / imgn_omtp /
  DATA mg20_map ( is_ionone_b ) / imgn_omtp /
  DATA mg20_map ( is_bornyl_act ) / imgn_omtp /
  DATA mg20_map ( is_farnescene_a ) / imgn_afarn /
  DATA mg20_map ( is_caryophyllene_b ) / imgn_bcar /
  DATA mg20_map ( is_acoradiene ) / imgn_osqt /
  DATA mg20_map ( is_aromadendrene ) / imgn_osqt /
  DATA mg20_map ( is_bergamotene_a ) / imgn_osqt /
  DATA mg20_map ( is_bergamotene_b ) / imgn_osqt /
  DATA mg20_map ( is_bisabolene_a ) / imgn_osqt /
  DATA mg20_map ( is_bisabolene_b ) / imgn_osqt /
  DATA mg20_map ( is_bourbonene_b ) / imgn_osqt /
  DATA mg20_map ( is_cadinene_d ) / imgn_osqt /
  DATA mg20_map ( is_cadinene_g ) / imgn_osqt /
  DATA mg20_map ( is_cedrene_a ) / imgn_osqt /
  DATA mg20_map ( is_copaene_a ) / imgn_osqt /
  DATA mg20_map ( is_cubebene_a ) / imgn_osqt /
  DATA mg20_map ( is_cubebene_b ) / imgn_osqt /
  DATA mg20_map ( is_elemene_b ) / imgn_osqt /
  DATA mg20_map ( is_farnescene_b ) / imgn_osqt /
  DATA mg20_map ( is_germacrene_b ) / imgn_osqt /
  DATA mg20_map ( is_germacrene_d ) / imgn_osqt /
  DATA mg20_map ( is_gurjunene_b ) / imgn_osqt /
  DATA mg20_map ( is_humulene_a ) / imgn_osqt /
  DATA mg20_map ( is_humulene_g ) / imgn_osqt /
  DATA mg20_map ( is_isolongifolene ) / imgn_osqt /
  DATA mg20_map ( is_longifolene ) / imgn_osqt /
  DATA mg20_map ( is_longipinene ) / imgn_osqt /
  DATA mg20_map ( is_muurolene_a ) / imgn_osqt /
  DATA mg20_map ( is_muurolene_g ) / imgn_osqt /
  DATA mg20_map ( is_selinene_b ) / imgn_osqt /
  DATA mg20_map ( is_selinene_d ) / imgn_osqt /
  DATA mg20_map ( is_nerolidol_c ) / imgn_osqt /
  DATA mg20_map ( is_nerolidol_t ) / imgn_osqt /
  DATA mg20_map ( is_cedrol ) / imgn_osqt /
  DATA mg20_map ( is_mbo_2m3e2ol ) / imgn_mbo /
  DATA mg20_map ( is_methanol ) / imgn_meoh /
  DATA mg20_map ( is_acetone ) / imgn_acto /
  DATA mg20_map ( is_methane ) / imgn_ch4 /
  DATA mg20_map ( is_ammonia ) / imgn_no /
  DATA mg20_map ( is_nitrous_oxd ) / imgn_no /
  DATA mg20_map ( is_nitric_oxd ) / imgn_no /
  DATA mg20_map ( is_acetaldehyde ) / imgn_acta /
  DATA mg20_map ( is_ethanol ) / imgn_acta /
  DATA mg20_map ( is_formic_acid ) / imgn_form /
  DATA mg20_map ( is_formaldehyde ) / imgn_form /
  DATA mg20_map ( is_acetic_acid ) / imgn_form /
  DATA mg20_map ( is_mbo_3m2e1ol ) / imgn_co /
  DATA mg20_map ( is_mbo_3m3e1ol ) / imgn_co /
  DATA mg20_map ( is_benzaldehyde ) / imgn_co /
  DATA mg20_map ( is_butanone_2 ) / imgn_co /
  DATA mg20_map ( is_decanal ) / imgn_co /
  DATA mg20_map ( is_dodecene_1 ) / imgn_co /
  DATA mg20_map ( is_geranyl_acetone ) / imgn_co /
  DATA mg20_map ( is_heptanal ) / imgn_co /
  DATA mg20_map ( is_heptane ) / imgn_co /
  DATA mg20_map ( is_hexane ) / imgn_co /
  DATA mg20_map ( is_met_benzoate ) / imgn_co /
  DATA mg20_map ( is_met_heptenone ) / imgn_co /
  DATA mg20_map ( is_neryl_acetone ) / imgn_co /
  DATA mg20_map ( is_nonanal ) / imgn_co /
  DATA mg20_map ( is_nonenal ) / imgn_co /
  DATA mg20_map ( is_octanal ) / imgn_co /
  DATA mg20_map ( is_octanol ) / imgn_co /
  DATA mg20_map ( is_octenol_1e3ol ) / imgn_co /
  DATA mg20_map ( is_oxopentanal ) / imgn_co /
  DATA mg20_map ( is_pentane ) / imgn_co /
  DATA mg20_map ( is_phenyl_cco ) / imgn_co /
  DATA mg20_map ( is_pyruvic_acid ) / imgn_co /
  DATA mg20_map ( is_terpinyl_act_a ) / imgn_co /
  DATA mg20_map ( is_tetradecene_1 ) / imgn_co /
  DATA mg20_map ( is_toluene ) / imgn_co /
  DATA mg20_map ( is_carbon_monoxide ) / imgn_co /
  DATA mg20_map ( is_butene ) / imgn_co /
  DATA mg20_map ( is_ethane ) / imgn_co /
  DATA mg20_map ( is_ethene ) / imgn_co /
  DATA mg20_map ( is_hydrogen_cyanide) / imgn_co /
  DATA mg20_map ( is_propane ) / imgn_co /
  DATA mg20_map ( is_propene ) / imgn_co /
  DATA mg20_map ( is_carbon_2s ) / imgn_co /
  DATA mg20_map ( is_carbonyl_s ) / imgn_co /
  DATA mg20_map ( is_diallyl_2s ) / imgn_co /
  DATA mg20_map ( is_2met_2s ) / imgn_co /
  DATA mg20_map ( is_2met_s ) / imgn_co /
  DATA mg20_map ( is_met_chloride ) / imgn_co /
  DATA mg20_map ( is_met_bromide ) / imgn_co /
  DATA mg20_map ( is_met_iodide ) / imgn_co /
  DATA mg20_map ( is_hydrogen_s ) / imgn_co /
  DATA mg20_map ( is_met_mercaptan ) / imgn_co /
  DATA mg20_map ( is_met_propenyl_2s ) / imgn_co /
  DATA mg20_map ( is_pppp_2s ) / imgn_co /
  DATA mg20_map ( is_2met_nonatriene ) / imgn_co /
  DATA mg20_map ( is_met_salicylate ) / imgn_co /
  DATA mg20_map ( is_indole ) / imgn_co /
  DATA mg20_map ( is_jasmone ) / imgn_co /
  DATA mg20_map ( is_met_jasmonate ) / imgn_co /
  DATA mg20_map ( is_3met_3dctt ) / imgn_co /
  DATA mg20_map ( is_hexanal ) / imgn_co /
  DATA mg20_map ( is_hexanol_1 ) / imgn_co /
  DATA mg20_map ( is_hexenal_c3 ) / imgn_co /
  DATA mg20_map ( is_hexenal_t2 ) / imgn_co /
  DATA mg20_map ( is_hexenol_c3 ) / imgn_co /
  DATA mg20_map ( is_hexenyl_act_c3 ) / imgn_co /
  REAL, DIMENSION (n_spca_spc, n_pft) :: EF_frac
  DATA EF_frac( is_isoprene , k_bt:k_hb ) / 1.000000 , 1.000000 , 1.000000 , 1.000000 /
  DATA EF_frac( is_myrcene , k_bt:k_hb ) / 1.000000 , 1.000000 , 1.000000 , 1.000000 /
  DATA EF_frac( is_sabinene , k_bt:k_hb ) / 1.000000 , 1.000000 , 1.000000 , 1.000000 /
  DATA EF_frac( is_limonene , k_bt:k_hb ) / 1.000000 , 1.000000 , 1.000000 , 1.000000 /
  DATA EF_frac( is_carene_3 , k_bt:k_hb ) / 1.000000 , 1.000000 , 1.000000 , 1.000000 /
  DATA EF_frac( is_ocimene_t_b , k_bt:k_hb ) / 1.000000 , 1.000000 , 1.000000 , 1.000000 /
  DATA EF_frac( is_pinene_b , k_bt:k_hb ) / 1.000000 , 1.000000 , 1.000000 , 1.000000 /
  DATA EF_frac( is_pinene_a , k_bt:k_hb ) / 1.000000 , 1.000000 , 1.000000 , 1.000000 /
  DATA EF_frac( is_2met_styrene , k_bt:k_hb ) / 0.011470 , 0.005540 , 0.009240 , 0.010400 /
  DATA EF_frac( is_cymene_p , k_bt:k_hb ) / 0.057340 , 0.055430 , 0.046210 , 0.041580 /
  DATA EF_frac( is_cymene_o , k_bt:k_hb ) / 0.034400 , 0.016630 , 0.027730 , 0.031190 /
  DATA EF_frac( is_phellandrene_a , k_bt:k_hb ) / 0.045870 , 0.055430 , 0.046210 , 0.041580 /
  DATA EF_frac( is_thujene_a , k_bt:k_hb ) / 0.011470 , 0.033260 , 0.036970 , 0.041580 /
  DATA EF_frac( is_terpinene_a , k_bt:k_hb ) / 0.057340 , 0.055430 , 0.046210 , 0.041580 /
  DATA EF_frac( is_terpinene_g , k_bt:k_hb ) / 0.057340 , 0.055430 , 0.046210 , 0.041580 /
  DATA EF_frac( is_terpinolene , k_bt:k_hb ) / 0.057340 , 0.066520 , 0.055450 , 0.062370 /
  DATA EF_frac( is_phellandrene_b , k_bt:k_hb ) / 0.057340 , 0.166300 , 0.092420 , 0.103950 /
  DATA EF_frac( is_camphene , k_bt:k_hb ) / 0.172020 , 0.249450 , 0.184840 , 0.145530 /
  DATA EF_frac( is_bornene , k_bt:k_hb ) / 0.010320 , 0.004990 , 0.008320 , 0.008320 /
  DATA EF_frac( is_fenchene_a , k_bt:k_hb ) / 0.003440 , 0.001660 , 0.002770 , 0.004160 /
  DATA EF_frac( is_ocimene_al , k_bt:k_hb ) / 0.011470 , 0.005540 , 0.009240 , 0.010400 /
  DATA EF_frac( is_ocimene_c_b , k_bt:k_hb ) / 0.045870 , 0.022170 , 0.036970 , 0.041580 /
  DATA EF_frac( is_tricyclene , k_bt:k_hb ) / 0.011470 , 0.005540 , 0.009240 , 0.010400 /
  DATA EF_frac( is_estragole , k_bt:k_hb ) / 0.003440 , 0.001660 , 0.002770 , 0.004160 /
  DATA EF_frac( is_camphor , k_bt:k_hb ) / 0.034400 , 0.033260 , 0.046210 , 0.041580 /
  DATA EF_frac( is_fenchone , k_bt:k_hb ) / 0.011470 , 0.005540 , 0.009240 , 0.010400 /
  DATA EF_frac( is_piperitone , k_bt:k_hb ) / 0.003440 , 0.001660 , 0.002770 , 0.004160 /
  DATA EF_frac( is_thujone_a , k_bt:k_hb ) / 0.011470 , 0.027720 , 0.046210 , 0.041580 /
  DATA EF_frac( is_thujone_b , k_bt:k_hb ) / 0.002290 , 0.005540 , 0.009240 , 0.010400 /
  DATA EF_frac( is_cineole_1_8 , k_bt:k_hb ) / 0.057340 , 0.011090 , 0.036970 , 0.041580 /
  DATA EF_frac( is_borneol , k_bt:k_hb ) / 0.008030 , 0.003880 , 0.006470 , 0.006240 /
  DATA EF_frac( is_linalool , k_bt:k_hb ) / 0.137610 , 0.066520 , 0.110910 , 0.124740 /
  DATA EF_frac( is_terpineol_4 , k_bt:k_hb ) / 0.006880 , 0.003330 , 0.005550 , 0.006240 /
  DATA EF_frac( is_terpineol_a , k_bt:k_hb ) / 0.034400 , 0.016630 , 0.027730 , 0.031190 /
  DATA EF_frac( is_linalool_oxd_c , k_bt:k_hb ) / 0.006880 , 0.003330 , 0.005550 , 0.006240 /
  DATA EF_frac( is_linalool_oxd_t , k_bt:k_hb ) / 0.034400 , 0.016630 , 0.027730 , 0.031190 /
  DATA EF_frac( is_ionone_b , k_bt:k_hb ) / 0.002290 , 0.001110 , 0.001850 , 0.002080 /
  DATA EF_frac( is_bornyl_act , k_bt:k_hb ) / 0.001150 , 0.002770 , 0.002770 , 0.002080 /
  DATA EF_frac( is_farnescene_a , k_bt:k_hb ) / 1.000000 , 1.000000 , 1.000000 , 1.000000 /
  DATA EF_frac( is_caryophyllene_b , k_bt:k_hb ) / 1.000000 , 1.000000 , 1.000000 , 1.000000 /
  DATA EF_frac( is_acoradiene , k_bt:k_hb ) / 0.018570 , 0.015950 , 0.019160 , 0.021860 /
  DATA EF_frac( is_aromadendrene , k_bt:k_hb ) / 0.007430 , 0.006380 , 0.007660 , 0.010930 /
  DATA EF_frac( is_bergamotene_a , k_bt:k_hb ) / 0.083570 , 0.143540 , 0.095790 , 0.098360 /
  DATA EF_frac( is_bergamotene_b , k_bt:k_hb ) / 0.001860 , 0.001590 , 0.001920 , 0.005460 /
  DATA EF_frac( is_bisabolene_a , k_bt:k_hb ) / 0.001860 , 0.001590 , 0.001920 , 0.005460 /
  DATA EF_frac( is_bisabolene_b , k_bt:k_hb ) / 0.055710 , 0.119620 , 0.067050 , 0.076500 /
  DATA EF_frac( is_bourbonene_b , k_bt:k_hb ) / 0.027860 , 0.023920 , 0.028740 , 0.032790 /
  DATA EF_frac( is_cadinene_d , k_bt:k_hb ) / 0.013930 , 0.011960 , 0.014370 , 0.016390 /
  DATA EF_frac( is_cadinene_g , k_bt:k_hb ) / 0.009290 , 0.007970 , 0.009580 , 0.010930 /
  DATA EF_frac( is_cedrene_a , k_bt:k_hb ) / 0.005570 , 0.004780 , 0.005750 , 0.005460 /
  DATA EF_frac( is_copaene_a , k_bt:k_hb ) / 0.009290 , 0.007970 , 0.009580 , 0.010930 /
  DATA EF_frac( is_cubebene_a , k_bt:k_hb ) / 0.013930 , 0.011960 , 0.014370 , 0.016390 /
  DATA EF_frac( is_cubebene_b , k_bt:k_hb ) / 0.009290 , 0.007970 , 0.009580 , 0.010930 /
  DATA EF_frac( is_elemene_b , k_bt:k_hb ) / 0.018570 , 0.015950 , 0.019160 , 0.021860 /
  DATA EF_frac( is_farnescene_b , k_bt:k_hb ) / 0.278550 , 0.239230 , 0.287360 , 0.218580 /
  DATA EF_frac( is_germacrene_b , k_bt:k_hb ) / 0.009290 , 0.007970 , 0.009580 , 0.010930 /
  DATA EF_frac( is_germacrene_d , k_bt:k_hb ) / 0.027860 , 0.023920 , 0.028740 , 0.032790 /
  DATA EF_frac( is_gurjunene_b , k_bt:k_hb ) / 0.004640 , 0.003990 , 0.004790 , 0.005460 /
  DATA EF_frac( is_humulene_a , k_bt:k_hb ) / 0.139280 , 0.199360 , 0.172410 , 0.163930 /
  DATA EF_frac( is_humulene_g , k_bt:k_hb ) / 0.001860 , 0.001590 , 0.001920 , 0.005460 /
  DATA EF_frac( is_isolongifolene , k_bt:k_hb ) / 0.001860 , 0.001590 , 0.001920 , 0.005460 /
  DATA EF_frac( is_longifolene , k_bt:k_hb ) / 0.001860 , 0.001590 , 0.001920 , 0.005460 /
  DATA EF_frac( is_longipinene , k_bt:k_hb ) / 0.001860 , 0.001590 , 0.001920 , 0.005460 /
  DATA EF_frac( is_muurolene_a , k_bt:k_hb ) / 0.013930 , 0.011960 , 0.014370 , 0.016390 /
  DATA EF_frac( is_muurolene_g , k_bt:k_hb ) / 0.046430 , 0.039870 , 0.047890 , 0.054640 /
  DATA EF_frac( is_selinene_b , k_bt:k_hb ) / 0.185700 , 0.079740 , 0.114940 , 0.109290 /
  DATA EF_frac( is_selinene_d , k_bt:k_hb ) / 0.001860 , 0.001590 , 0.001920 , 0.005460 /
  DATA EF_frac( is_nerolidol_c , k_bt:k_hb ) / 0.001860 , 0.001590 , 0.001920 , 0.005460 /
  DATA EF_frac( is_nerolidol_t , k_bt:k_hb ) / 0.004640 , 0.001590 , 0.001920 , 0.005460 /
  DATA EF_frac( is_cedrol , k_bt:k_hb ) / 0.001860 , 0.001590 , 0.001920 , 0.005460 /
  DATA EF_frac( is_mbo_2m3e2ol , k_bt:k_hb ) / 1.000000 , 1.000000 , 1.000000 , 1.000000 /
  DATA EF_frac( is_methanol , k_bt:k_hb ) / 1.000000 , 1.000000 , 1.000000 , 1.000000 /
  DATA EF_frac( is_acetone , k_bt:k_hb ) / 1.000000 , 1.000000 , 1.000000 , 1.000000 /
  DATA EF_frac( is_methane , k_bt:k_hb ) / 1.000000 , 1.000000 , 1.000000 , 1.000000 /
  DATA EF_frac( is_ammonia , k_bt:k_hb ) / 0.000000 , 0.000000 , 0.000000 , 0.000000 /
  DATA EF_frac( is_nitrous_oxd , k_bt:k_hb ) / 0.000000 , 0.000000 , 0.000000 , 0.000000 /
  DATA EF_frac( is_nitric_oxd , k_bt:k_hb ) / 1.000000 , 1.000000 , 1.000000 , 1.000000 /
  DATA EF_frac( is_acetaldehyde , k_bt:k_hb ) / 0.500000 , 0.500000 , 0.500000 , 0.500000 /
  DATA EF_frac( is_ethanol , k_bt:k_hb ) / 0.500000 , 0.500000 , 0.500000 , 0.500000 /
  DATA EF_frac( is_formic_acid , k_bt:k_hb ) / 0.285710 , 0.285710 , 0.285710 , 0.285710 /
  DATA EF_frac( is_formaldehyde , k_bt:k_hb ) / 0.428570 , 0.428570 , 0.428570 , 0.428570 /
  DATA EF_frac( is_acetic_acid , k_bt:k_hb ) / 0.285710 , 0.285710 , 0.285710 , 0.285710 /
  DATA EF_frac( is_mbo_3m2e1ol , k_bt:k_hb ) / 0.000520 , 0.000520 , 0.000520 , 0.000520 /
  DATA EF_frac( is_mbo_3m3e1ol , k_bt:k_hb ) / 0.000520 , 0.000520 , 0.000520 , 0.000520 /
  DATA EF_frac( is_benzaldehyde , k_bt:k_hb ) / 0.000210 , 0.000210 , 0.000210 , 0.000210 /
  DATA EF_frac( is_butanone_2 , k_bt:k_hb ) / 0.001030 , 0.001030 , 0.001030 , 0.001030 /
  DATA EF_frac( is_decanal , k_bt:k_hb ) / 0.000210 , 0.000210 , 0.000210 , 0.000210 /
  DATA EF_frac( is_dodecene_1 , k_bt:k_hb ) / 0.000210 , 0.000210 , 0.000210 , 0.000210 /
  DATA EF_frac( is_geranyl_acetone , k_bt:k_hb ) / 0.003100 , 0.003100 , 0.003100 , 0.003100 /
  DATA EF_frac( is_heptanal , k_bt:k_hb ) / 0.000210 , 0.000210 , 0.000210 , 0.000210 /
  DATA EF_frac( is_heptane , k_bt:k_hb ) / 0.000210 , 0.000210 , 0.000210 , 0.000210 /
  DATA EF_frac( is_hexane , k_bt:k_hb ) / 0.000100 , 0.000100 , 0.000100 , 0.000100 /
  DATA EF_frac( is_met_benzoate , k_bt:k_hb ) / 0.000100 , 0.000100 , 0.000100 , 0.000100 /
  DATA EF_frac( is_met_heptenone , k_bt:k_hb ) / 0.000210 , 0.000210 , 0.000210 , 0.000210 /
  DATA EF_frac( is_neryl_acetone , k_bt:k_hb ) / 0.000100 , 0.000100 , 0.000100 , 0.000100 /
  DATA EF_frac( is_nonanal , k_bt:k_hb ) / 0.000210 , 0.000210 , 0.000210 , 0.000210 /
  DATA EF_frac( is_nonenal , k_bt:k_hb ) / 0.000100 , 0.000100 , 0.000100 , 0.000100 /
  DATA EF_frac( is_octanal , k_bt:k_hb ) / 0.000210 , 0.000210 , 0.000210 , 0.000210 /
  DATA EF_frac( is_octanol , k_bt:k_hb ) / 0.000210 , 0.000210 , 0.000210 , 0.000210 /
  DATA EF_frac( is_octenol_1e3ol , k_bt:k_hb ) / 0.000210 , 0.000210 , 0.000210 , 0.000210 /
  DATA EF_frac( is_oxopentanal , k_bt:k_hb ) / 0.000210 , 0.000210 , 0.000210 , 0.000210 /
  DATA EF_frac( is_pentane , k_bt:k_hb ) / 0.000100 , 0.000100 , 0.000100 , 0.000100 /
  DATA EF_frac( is_phenyl_cco , k_bt:k_hb ) / 0.000100 , 0.000100 , 0.000100 , 0.000100 /
  DATA EF_frac( is_pyruvic_acid , k_bt:k_hb ) / 0.002060 , 0.002060 , 0.002060 , 0.002060 /
  DATA EF_frac( is_terpinyl_act_a , k_bt:k_hb ) / 0.000100 , 0.000100 , 0.000100 , 0.000100 /
  DATA EF_frac( is_tetradecene_1 , k_bt:k_hb ) / 0.000100 , 0.000100 , 0.000100 , 0.000100 /
  DATA EF_frac( is_toluene , k_bt:k_hb ) / 0.002060 , 0.002060 , 0.002060 , 0.002060 /
  DATA EF_frac( is_carbon_monoxide , k_bt:k_hb ) / 0.619070 , 0.619070 , 0.619070 , 0.619070 /
  DATA EF_frac( is_butene , k_bt:k_hb ) / 0.036110 , 0.036110 , 0.036110 , 0.036110 /
  DATA EF_frac( is_ethane , k_bt:k_hb ) / 0.002060 , 0.002060 , 0.002060 , 0.002060 /
  DATA EF_frac( is_ethene , k_bt:k_hb ) / 0.134130 , 0.134130 , 0.134130 , 0.134130 /
  DATA EF_frac( is_hydrogen_cyanide, k_bt:k_hb ) / 0.004130 , 0.004130 , 0.004130 , 0.004130 /
  DATA EF_frac( is_propane , k_bt:k_hb ) / 0.001030 , 0.001030 , 0.001030 , 0.001030 /
  DATA EF_frac( is_propene , k_bt:k_hb ) / 0.082540 , 0.082540 , 0.082540 , 0.082540 /
  DATA EF_frac( is_carbon_2s , k_bt:k_hb ) / 0.000310 , 0.000310 , 0.000310 , 0.000310 /
  DATA EF_frac( is_carbonyl_s , k_bt:k_hb ) / 0.000620 , 0.000620 , 0.000620 , 0.000620 /
  DATA EF_frac( is_diallyl_2s , k_bt:k_hb ) / 0.000100 , 0.000100 , 0.000100 , 0.000100 /
  DATA EF_frac( is_2met_2s , k_bt:k_hb ) / 0.000310 , 0.000310 , 0.000310 , 0.000310 /
  DATA EF_frac( is_2met_s , k_bt:k_hb ) / 0.001240 , 0.001240 , 0.001240 , 0.001240 /
  DATA EF_frac( is_met_chloride , k_bt:k_hb ) / 0.001030 , 0.001030 , 0.001030 , 0.001030 /
  DATA EF_frac( is_met_bromide , k_bt:k_hb ) / 0.000210 , 0.000210 , 0.000210 , 0.000210 /
  DATA EF_frac( is_met_iodide , k_bt:k_hb ) / 0.000100 , 0.000100 , 0.000100 , 0.000100 /
  DATA EF_frac( is_hydrogen_s , k_bt:k_hb ) / 0.000520 , 0.000520 , 0.000520 , 0.000520 /
  DATA EF_frac( is_met_mercaptan , k_bt:k_hb ) / 0.000100 , 0.000100 , 0.000100 , 0.000100 /
  DATA EF_frac( is_met_propenyl_2s , k_bt:k_hb ) / 0.000100 , 0.000100 , 0.000100 , 0.000100 /
  DATA EF_frac( is_pppp_2s , k_bt:k_hb ) / 0.000100 , 0.000100 , 0.000100 , 0.000100 /
  DATA EF_frac( is_2met_nonatriene , k_bt:k_hb ) / 0.020640 , 0.020640 , 0.020640 , 0.020640 /
  DATA EF_frac( is_met_salicylate , k_bt:k_hb ) / 0.002060 , 0.002060 , 0.002060 , 0.002060 /
  DATA EF_frac( is_indole , k_bt:k_hb ) / 0.000210 , 0.000210 , 0.000210 , 0.000210 /
  DATA EF_frac( is_jasmone , k_bt:k_hb ) / 0.000210 , 0.000210 , 0.000210 , 0.000210 /
  DATA EF_frac( is_met_jasmonate , k_bt:k_hb ) / 0.002060 , 0.002060 , 0.002060 , 0.002060 /
  DATA EF_frac( is_3met_3dctt , k_bt:k_hb ) / 0.000210 , 0.000210 , 0.000210 , 0.000210 /
  DATA EF_frac( is_hexanal , k_bt:k_hb ) / 0.003100 , 0.003100 , 0.003100 , 0.003100 /
  DATA EF_frac( is_hexanol_1 , k_bt:k_hb ) / 0.003100 , 0.003100 , 0.003100 , 0.003100 /
  DATA EF_frac( is_hexenal_c3 , k_bt:k_hb ) / 0.025790 , 0.025790 , 0.025790 , 0.025790 /
  DATA EF_frac( is_hexenal_t2 , k_bt:k_hb ) / 0.015480 , 0.015480 , 0.015480 , 0.015480 /
  DATA EF_frac( is_hexenol_c3 , k_bt:k_hb ) / 0.015480 , 0.015480 , 0.015480 , 0.015480 /
  DATA EF_frac( is_hexenyl_act_c3 , k_bt:k_hb ) / 0.015480 , 0.015480 , 0.015480 , 0.015480 /
END MODULE module_data_megan2


      SUBROUTINE MONTEFE
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER*8 (I-N)
      COMMON/INPT/NGAS,NSTEP,NANISO,EFINAL,ESTEP,AKT,ARY,TEMPC,TORR,IPEN
      COMMON/INPT1/NDVEC
      COMMON/CNSTS1/CONST1,CONST2,CONST3,CONST4,CONST5
      COMMON/SETP/TMAX,SMALL,API,ESTART,THETA,PHI,TCFMAX(10),TCFMAX1,
     /RSTART,EFIELD,ETHRM,ECUT,NDELTA,IMIP,IWRITE
      COMMON/LARGE/CF(20000,512),EIN(512),TCF(20000),IARRY(512),
     /RGAS(512),IPN(512),WPL(512),IZBR(512),IPLAST,PENFRA(3,512)
      COMMON/LARGEN/CFN(20000,60),TCFN(20000),SCLENUL(60),NPLAST
      COMMON/OUTPT/ICOLL(30),NETOT,NPRIME,TMAX1,TIME(300),NNULL,
     /NITOT,ICOLN(512),ICOLNN(60),NREAL,NEXCTOT
      COMMON/RLTVY/BET(20000),GAM(20000),VC,EMS
      COMMON/STTS/XST(150000),YST(150000),ZST(150000),TST(150000),
     /TTIME(150000),NFGF(150000),NFGPP(150000),NFGBR(150000),NELEC,
     /NEGION,EST1,EST2
      COMMON/STEXC/XSTEXC(150000),YSTEXC(150000),ZSTEXC(150000),
     /TSTEXC(150000),NSTEXC
      COMMON/STEXCNUL/XSTN(150000),YSTN(150000),ZSTN(150000),
     /TSTN(150000),IDNUL(150000),NEXCNUL
      COMMON/IONC/DOUBLE(6,20000),CMINIXSC(6),CMINEXSC(6),ECLOSS(6),
     /WPLN(6),ICOUNT,AVPFRAC(3,6)
      COMMON/IONFL/NC0(512),EC0(512),NG1(512),EG1(512),NG2(512),
     /EG2(512),WKLM(512),DSTFL(512)
      COMMON/IONMOD/ESPLIT(512,20),IONMODEL(512)
      COMMON/ANIS/PSCT(20000,512),ANGCT(20000,512),INDEX(512),NISO
      COMMON/CASRS/ECAS(400),XCAS(400),YCAS(400),ZCAS(400),DRXS(400),
     /DRYS(400),DRZS(400),TT1(400),NFLGF(400),NFLGPP(400),IEVNTL
      COMMON/COMP/LCMP,LCFLG,LRAY,LRFLG,LPAP,LPFLG,LBRM,LBFLG,LPEFLG
      COMMON/BREMG/EBRGAM(10),BRDCOSX(10),BRDCOSY(10),BRDCOSZ(10),
     /BRX(10),BRY(10),BRZ(10),BRT(10),EBRTOT(6),NBREM(6)
      COMMON/CASRSB/ECASB(400),XCASB(400),YCASB(400),ZCASB(400),
     /DRXB(400),DRYB(400),DRZB(400),TTB1(400),NFLGFB(400),NFLGPPB(400),
     /IEVNTLB
      COMMON/CASRSE/ECASE(400),XCASE(400),YCASE(400),ZCASE(400),
     /DRXCE(400),DRYCE(400),DRZCE(400),TCASE(400),
     /NFLGFE(400),NFLGPPE(400),IEVENTE
      COMMON/ECASC/NEGAS(512),LEGAS(512),IESHELL(512),IECASC
      COMMON/IDEXC/NGEXC1,NGEXC2,NGEXC3,NGEXC4,NGEXC5,NGEXC6,
     /IDG1,IDG2,IDG3,IDG4,IDG5,IDG6
      DIMENSION XS(150000),YS(150000),ZS(150000),TS(150000),ES(150000),
     /DCX(150000),DCY(150000),DCZ(150000),
     /NFLGFC(150000),NFLGPPC(150000),NFLGBRMC(150000)
      DIMENSION TEMP(20000)
C     DIMENSION ETEMP(1000)
C ----------------------------------------------------------------------
C      RELATIVISTIC VERSION SEPTEMBER 2013
C      ELECTRIC FIELD ALONG Z AXIS. NO MAGNETIC FIELD.
C      TRACKS DELTA ELECTRONS AND UPDATES ARRAYS CONTAINING POSITION AND
C      TIME OF THERMALISED ELECTRONS.
C     CALCULATES NUMBER OF PRODUCED ELECTRONS PER PRIMARY AND OTHER
C     HIGHER FANO FACTORS.
C     RANGE IS ACCURATE ONLY FOR ANISOTROPIC X-SECTIONS
C ----------------------------------------------------------------------
C VARYING ENERGY STEPS
      IF(EFINAL.LE.140000.) THEN
        ESTEP1=(EFINAL-16000.0)/DFLOAT(4000)
      ELSE
        ESTEP1=20.0
        ESTEP2=(EFINAL-92000.0)/DFLOAT(4000)
      ENDIF
      NPRINT=0
      J20000=20000
      J300=300
      API=DACOS(-1.0D0)
      SMALL=1.0D-20
      TMAX1=0.0D0
      EMAX=0.0D0
      RDUM=RSTART
      CONST9=CONST3*0.01D0
      DO 25 I=1,300
   25 TIME(I)=0.0D0
      DO 26 I=1,30
   26 ICOLL(I)=0
      DO 27 I=1,512
   27 ICOLN(I)=0
      NREAL=0
      NNULL=0
      NETOT=0
      NEXCTOT=0
      NITOT=0
      NMXADD=0
      NTMPFLG=0
      BP=EFIELD*EFIELD*CONST1
      F1=EFIELD*CONST2
      F2=EFIELD*CONST3
      F4=2.0D0*API
      THETA1=THETA
      PHI1=PHI
C CALCULATE MAXIMUM COLLISION FREQUENCY
      TLIM=0.0
      DO 111 J=1,20000
      TEMP(J)=TCFN(J)+TCF(J)
      IF(TLIM.LT.TEMP(J)) TLIM=TEMP(J)
  111 CONTINUE
      NEOVFL=0
      J1=0
C START OF PRIMARY EVENT LOOP
      DO 210 J11=1,NDELTA
      J1=J1+1
      NPRIME=J1
      NGEXC1=0
      NGEXC2=0
      NGEXC3=0
      NGEXC4=0
      NGEXC5=0
      NGEXC6=0
C     INITIAL DIRECTION COSINES FOR ELECTRON BEAM
      DCZ1=DCOS(THETA1)
      DCX1=DSIN(THETA1)*DCOS(PHI1)
      DCY1=DSIN(THETA1)*DSIN(PHI1)
      NFLGFF=0
      NFLGPPP=0
      NFLGBRMM=0
      NFLGHIGH=0
      EST1=ESTART
      E1=ESTART
      X=0.0D0
      Y=0.0D0
      Z=0.0D0
      K1=0
      KEXC=0
      NSTEXC=0
      NEXCNUL=0
      NCLUS=0
      NELEC=0
      NEGION=0
      TLAST=0.0D0
      ST=0.0D0
      TDASH=0.0D0
      IF(IMIP.EQ.2) GO TO 1
      IF(IMIP.GT.2) THEN
C READIN FIRST ELECTRON FROM BETA DECAY OR XRAY UNTHERMALISED CLUSTERS
       CALL CASRES(J11,IBADTOT,IBAD1)
C  SKIP IF BAD EVENT
       IF(IBAD1.EQ.1) THEN
        J1=J1-1
        GO TO 210
       ENDIF
      ELSE IF(IMIP.EQ.1) THEN
C READ IN FIRST ELECTRON FROM MIP INTERACTION
        CALL CASREM(J11)
        EST1=ECAS(1)
        EST2=EST1
      ENDIF
      X=XCAS(1)
      Y=YCAS(1)
      Z=ZCAS(1)
      ST=TT1(1)
      TS(1)=TT1(1)
      E1=ECAS(1)
      DCZ1=DRZS(1)
      DCY1=DRYS(1)
      DCX1=DRXS(1)
      NFLGFF=NFLGF(1)
      NFLGPPP=NFLGPP(1)
      NFLGBRMM=0
      NFLGHIGH=NFLGFF
C PUT REMAINDER OF ELECTRONS INTO CLUSTER STORE
      ISDUM=0
      DO 35 IST=2,IEVNTL
      ISDUM=ISDUM+1
      XS(ISDUM)=XCAS(IST)
      YS(ISDUM)=YCAS(IST)
      ZS(ISDUM)=ZCAS(IST)
      TS(ISDUM)=TT1(IST)
      ES(ISDUM)=ECAS(IST)
      DCX(ISDUM)=DRXS(IST)
      DCY(ISDUM)=DRYS(IST)
      DCZ(ISDUM)=DRZS(IST)
      NFLGFC(ISDUM)=NFLGF(IST)
      NFLGPPC(ISDUM)=NFLGPP(IST)
      NFLGBRMC(ISDUM)=0
      NCLUS=ISDUM
      IF(NFLGF(IST).GT.NFLGHIGH) NFLGHIGH=NFLGF(IST)
   35 CONTINUE

C START OF LOOP FOR NEWLY CREATED ELECTRONS
    1 CONTINUE
      R1=drand48(RDUM)
      T=-DLOG(R1)/TLIM+TDASH
      TDASH=T
C     AP=DCZ1*F2*DSQRT(E1)
      GAM1=(EMS+E1)/EMS
      BET1=DSQRT(1.0D0-1.0D0/(GAM1*GAM1))
      AP=DCZ1*EFIELD*BET1*VC*1.0D-10
      BP1=BP/GAM1
      E=E1+(AP+BP1*T)*T
      IF(E.LT.0.0D0) THEN
       E=0.001D0
      ENDIF
C INSERT NEW ALGORITHM TO FIND IE FOR VARYING ENERGY STEP
      IF(IMIP.EQ.1) THEN
       IE=DINT(E/ESTEP)+1
      ELSE
       IF(EFINAL.LE.20000.) THEN
        IE=DINT(E/ESTEP)+1
       ELSE IF(EFINAL.LE.140000.) THEN
        IF(E.LE.16000.) THEN
         IE=DINT(E)+1
        ELSE
         IE=16000+DINT((E-16000.)/ESTEP1)
        ENDIF
       ELSE
        IF(E.LE.12000.) THEN
         IE=DINT(E)+1
        ELSE IF(E.LE.92000.) THEN
         IE=12000+DINT((E-12000.)/ESTEP1)
        ELSE
         IE=16000+DINT((E-92000.)/ESTEP2)
        ENDIF
       ENDIF
      ENDIF
      IE=DMIN0(IE,J20000)
C
C     TEST FOR REAL OR NULL COLLISION
C
      R5=drand48(RDUM)
      TEST1=TCF(IE)/TLIM
      IF(R5.LE.TEST1) GO TO 137
      NNULL=NNULL+1
      TEST2=TEMP(IE)/TLIM
      IF(R5.LT.TEST2) THEN
C TEST FOR NULL LEVELS
       IF(NPLAST.EQ.0) GO TO 1
       R2=drand48(RDUM)
       I=0
  888  I=I+1
       IF(CFN(IE,I).LT.R2) GO TO 888
C INCREMENT NULL LEVEL SUM
       NEXCNUL=NEXCNUL+1
       ICOLNN(I)=ICOLNN(I)+1
C STORE X Y Z T ID FOR MOLECULAR LIGHT EMISSION FROM NULL EXCITATION
C NOTE:  SMALL APPROX USED POSITION OF PREVIOUS REAL COLLISION
       XSTN(NEXCNUL)=X
       YSTN(NEXCNUL)=Y
       ZSTN(NEXCNUL)=Z
       TSTN(NEXCNUL)=ST
       IDNUL(NEXCNUL)=I
       GO TO 1
      ELSE
C NULL
       GO TO 1
      ENDIF
C
C  CALCULATE DIRECTION COSINES AND POSITIONS AT INSTANT BEFORE COLLISION
  137 T2=T*T
      IF(E.GT.EMAX) EMAX=E
      IF(T.GT.TMAX1) TMAX1=T
      TDASH=0.0D0
      NREAL=NREAL+1
C     CONST6=DSQRT(E1/E)
      GAM2=(EMS+E)/EMS
      GAM12=(GAM1+GAM2)/2.0D0
      BET2=DSQRT(1.0D0-1.0D0/(GAM2*GAM2))
      CONST6=BET1/BET2
      DCX2=DCX1*CONST6
      DCY2=DCY1*CONST6
C     DCZ2=DCZ1*CONST6+EFIELD*T*CONST5/DSQRT(E)
      DCZ2=DCZ1*CONST6+EFIELD*T*2.0D10*CONST1/(VC*BET2)
C     CONST7=CONST9*DSQRT(E1)
      CONST7=VC*BET1*1.0D-12
      A=T*CONST7
      X=X+DCX1*A
      Y=Y+DCY1*A
      Z=Z+DCZ1*A+T2*F1/GAM12
C     Z=Z+DCZ1*A+T2*F1
      ST=ST+T
      IT=DINT(T+1.0D0)
      IT=DMIN0(IT,J300)
      TIME(IT)=TIME(IT)+1.0D0
C ---------------------------------------------------------------------
C     DETERMINATION OF REAL COLLISION TYPE
C ---------------------------------------------------------------------
      R2=drand48(RDUM)
      I=0
  140 I=I+1
      IF(CF(IE,I).LT.R2) GO TO 140
C************************************************************
C CHECK IF BREMSSTRAHLUNG
      IF(IZBR(I).NE.0.AND.LBRM.EQ.1) THEN
       NFLGBRMM=1
       IPT=IARRY(I)
       ICOLL(IPT)=ICOLL(IPT)+1
       ICOLN(I)=ICOLN(I)+1
       DO 141 KNGS=1,NGAS
       IF(IPT.EQ.(KNGS*5)-1) GO TO 142
  141  CONTINUE
  142  IATOMNO=IZBR(I)
       CALL BREMS(IATOMNO,E,DCX2,DCY2,DCZ2,EOUT,EDCX,EDCY,EDCZ,
     /EGAMMA,GDCX,GDCY,GDCZ)
       NBREM(KNGS)=NBREM(KNGS)+1
       EBRTOT(KNGS)=EBRTOT(KNGS)+EGAMMA
C GET  NEW DRCOS DRCOSY DRCOSX AND ENERGY OF ELECTRON
       E1=EOUT
       DCX1=EDCX
       DCY1=EDCY
       DCZ1=EDCZ
C RUN BREMSSTRAHLUNG GAMMA THROUGH CASCADE THEN STORE CONVERTED
C ELECTRONS IN COMMON/CASRSB/
C
       CALL BREMSCASC(J11,EGAMMA,X,Y,Z,ST,GDCX,GDCY,GDCZ,ILOW)
C BREMSSTRAHLUNG ENERGY TOO LOW TO IONISE
       IF(ILOW.EQ.1) GO TO 190
C
C  STORE BREMSSTRAHLUNG DATA IN CLUSTER STORE
C
       ETSUM=0.0
       DO 890 KBR=1,IEVNTLB
       NCLUS=NCLUS+1
       IF(NCLUS.GT.150000) THEN
        WRITE(6,546) NCLUS,NREAL
        STOP
       ENDIF
       ES(NCLUS)=ECASB(KBR)
       ETSUM=ETSUM+ES(NCLUS)
       XS(NCLUS)=XCASB(KBR)
       YS(NCLUS)=YCASB(KBR)
       ZS(NCLUS)=ZCASB(KBR)
       TS(NCLUS)=TTB1(KBR)
       DCX(NCLUS)=DRXB(KBR)
       DCY(NCLUS)=DRYB(KBR)
       DCZ(NCLUS)=DRZB(KBR)
       NFLGFC(NCLUS)=NFLGFB(KBR)+NFLGHIGH
       NFLGPPC(NCLUS)=NFLGPPB(KBR)
       NFLGBRMC(NCLUS)=2
  890  CONTINUE
       IF(NFLGFC(NCLUS).GT.NFLGHIGH) NFLGHIGH=NFLGFC(NCLUS)
       GO TO 190
      ENDIF
  891 CONTINUE
C*****************************************************************
C     S1=RGAS(I)
      S1=1.0D0+GAM2*(RGAS(I)-1.0D0)
      EI=EIN(I)
C     WRITE(6,8890) EIN(I),I
C8890 FORMAT(' EIN=',D12.4,' I=',I3)
      IF(E.LT.EI) THEN
      EI=E-0.0001D0
      ENDIF
      IF(IPN(I).EQ.0) GO TO 666
C ATTACHMENT
      IF(IPN(I).EQ.-1) THEN
       NETOT=NETOT+1
       NITOT=NITOT+1
       NELEC=NELEC+1
       NEGION=NEGION+1
       IPT=IARRY(I)
       ICOLL(IPT)=ICOLL(IPT)+1
       ICOLN(I)=ICOLN(I)+1
       IT=DINT(T+1.0D0)
       IT=DMIN0(IT,J300)
       TIME(IT)=TIME(IT)+1.0D0
       GO TO 335
      ENDIF
      EISTR=EI
      IF(IONMODEL(I).GT.0) THEN
C CALCULATE SECONDARY ENERGY,ESEC,IN IONISATION COLLISION USING
C FIVE DIFFERENT MODELS
       CALL IONSPLIT(I,E,EI,ESEC)
       GO TO 544
      ENDIF
      R9=drand48(RDUM)
C    USE OPAL PETERSON AND BEATY SPLITTING FACTOR.
      ESEC=WPL(I)*TAN(R9*ATAN((E-EI)/(2.0D0*WPL(I))))
      ESEC=WPL(I)*(ESEC/WPL(I))**0.9524
  544 CONTINUE
      EI=ESEC+EI
C STORE POSITION ,ENERGY, DIRECTION COSINES AND TIME OF GENERATION
C OF SECONDARY IONISATION ELECTRONS
      NCLUS=NCLUS+1
      NMXADD=MAX(NCLUS,NMXADD)
      IF(NCLUS.GT.150000) THEN
      WRITE(6,546) NCLUS,NREAL
 546  FORMAT(2X,' PROGRAM STOPPED . NCLUS=',I7,' NREAL=',I10)
      STOP
      ENDIF
      XS(NCLUS)=X
      YS(NCLUS)=Y
      ZS(NCLUS)=Z
      TS(NCLUS)=ST
      ES(NCLUS)=ESEC
      NFLGFC(NCLUS)=NFLGFF
      NFLGPPC(NCLUS)=NFLGPPP
      NFLGBRMC(NCLUS)=NFLGBRMM
      NTMPFLG=1
      NCLTMP=NCLUS
C     ES(NCLUS)=ESEC
C RANDOMISE SECONDARY ELECTRON DIRECTION
C     R3=drand48(RDUM)
C     F3=1.0-2.0D0*R3
C     THETA0=DACOS(F3)
C     F6=DCOS(THETA0)
C     F5=DSIN(THETA0)
C     R4=drand48(RDUM)
C     PHI0=F4*R4
C     F8=DSIN(PHI0)
C     F9=DCOS(PHI0)
C     DCX(NCLUS)=F9*F5
C     DCY(NCLUS)=F8*F5
C     DCZ(NCLUS)=F6
C*********************************************************
      IF(IECASC.EQ.0)GO TO 333
      IF(LEGAS(I).EQ.0) GO TO 333
C USE COMPLETE CASCADE FOR ELECTRON IONISATION
      KG1=NEGAS(I)
      LG1=LEGAS(I)
      IGSHEL=IESHELL(I)
      CALL CASCADEE(J11,KG1,LG1,X,Y,Z,ST,ESEC,IGSHEL)
C
C STORE CASCADE IN CLUSTER STORE
C
      ETSUM=0.0
      DO 844 KBR=1,IEVENTE
      NCLUS=NCLUS+1
      IF(NCLUS.GT.150000) THEN
       WRITE(6,546) NCLUS,NREAL
       STOP
      ENDIF
      ES(NCLUS)=ECASE(KBR)
      ETSUM=ETSUM+ES(NCLUS)
      XS(NCLUS)=XCASE(KBR)
      YS(NCLUS)=YCASE(KBR)
      ZS(NCLUS)=ZCASE(KBR)
      TS(NCLUS)=TCASE(KBR)
      DCX(NCLUS)=DRXCE(KBR)
      DCY(NCLUS)=DRYCE(KBR)
      DCZ(NCLUS)=DRZCE(KBR)
      NFLGFC(NCLUS)=NFLGFE(KBR)+NFLGHIGH
      NFLGPPC(NCLUS)=NFLGPPE(KBR)
      NFLGBRMC(NCLUS)=NFLGBRMM
  844 CONTINUE
      IF(NFLGFC(NCLUS).GT.NFLGHIGH) NFLGHIGH=NFLGFC(NCLUS)
      GO TO 666
C*********************************************************
C STORE POSSIBLE SHELL EMISSIONS AUGER OR FLUORESCENCE
  333 IF(EISTR.GT.30.0) THEN
C      WRITE(6,8891) EISTR
C8891  FORMAT(' EISTR=',D12.4)
C TEST IF FLUORESCENCE EMISSION
       IFLTST=0
       IF(WKLM(I).GT.0.0) THEN
        R9=drand48(RDUM)
        IF(R9.LT.WKLM(I)) IFLTST=1
       ENDIF
       IF(IFLTST.EQ.0) THEN
C AUGER EMISSION WITHOUT FLUORESCENCE
        NAUG=NC0(I)
        EAVAUG=EC0(I)/DFLOAT(NAUG)
        DO 700 JFL=1,NC0(I)
        NCLUS=NCLUS+1
        XS(NCLUS)=X
        YS(NCLUS)=Y
        ZS(NCLUS)=Z
        TS(NCLUS)=ST
        NFLGFC(NCLUS)=NFLGFF
        NFLGPPC(NCLUS)=NFLGPPP
        NFLGBRMC(NCLUS)=NFLGBRMM
        ES(NCLUS)=EAVAUG
        R3=drand48(RDUM)
        F3=1.0-2.0D0*R3
        THETA0=DACOS(F3)
        F6=DCOS(THETA0)
        F5=DSIN(THETA0)
        R4=drand48(RDUM)
        PHI0=F4*R4
        F8=DSIN(PHI0)
        F9=DCOS(PHI0)
        DCX(NCLUS)=F9*F5
        DCY(NCLUS)=F8*F5
        DCZ(NCLUS)=F6
  700   CONTINUE
       ELSE
C AUGER EMISSION AND FLUORESENCE
        IF(NG2(I).EQ.0) GO TO 702
        NAUG=NG2(I)
        EAVAUG=EG2(I)/DFLOAT(NAUG)
        DO 701 JFL=1,NG2(I)
        NCLUS=NCLUS+1
        XS(NCLUS)=X
        YS(NCLUS)=Y
        ZS(NCLUS)=Z
        NFLGFC(NCLUS)=NFLGFF
        NFLGPPC(NCLUS)=NFLGPPP
        NFLGBRMC(NCLUS)=NFLGBRMM
        TS(NCLUS)=ST
        ES(NCLUS)=EAVAUG
        R3=drand48(RDUM)
        F3=1.0-2.0D0*R3
        THETA0=DACOS(F3)
        F6=DCOS(THETA0)
        F5=DSIN(THETA0)
        R4=drand48(RDUM)
        PHI0=F4*R4
        F8=DSIN(PHI0)
        F9=DCOS(PHI0)
        DCX(NCLUS)=F9*F5
        DCY(NCLUS)=F8*F5
        DCZ(NCLUS)=F6
  701   CONTINUE
  702   IF(NG1(I).EQ.0) GO TO 704
        NAUG=NG1(I)
        EAVAUG=EG1(I)/DFLOAT(NAUG)
        R9=drand48(RDUM)
        DFL=-DLOG(R9)*DSTFL(I)
        DO 703 JFL=1,NG1(I)
        NCLUS=NCLUS+1
        R3=drand48(RDUM)
        THEFL=DACOS(1.0-2.0D0*R3)
        R4=drand48(RDUM)
        PHIFL=F4*R4
        XS(NCLUS)=X+DFL*DSIN(THEFL)*DCOS(PHIFL)
        YS(NCLUS)=Y+DFL*DSIN(THEFL)*DSIN(PHIFL)
        ZS(NCLUS)=Z+DFL*DCOS(THEFL)
        NFLGFC(NCLUS)=NFLGHIGH+1
        NFLGPPC(NCLUS)=NFLGPPP
        NFLGBRMC(NCLUS)=NFLGBRMM
        TS(NCLUS)=ST
        ES(NCLUS)=EAVAUG
        R3=drand48(RDUM)
        F3=1.0-2.0D0*R3
        THETA0=DACOS(F3)
        F6=DCOS(THETA0)
        F5=DSIN(THETA0)
        R4=drand48(RDUM)
        PHI0=F4*R4
        F8=DSIN(PHI0)
        F9=DCOS(PHI0)
        DCX(NCLUS)=F9*F5
        DCY(NCLUS)=F8*F5
        DCZ(NCLUS)=F6
        NFLGHIGH=NFLGFC(NCLUS)
  703   CONTINUE
  704   CONTINUE
       ENDIF
      ENDIF
C
C  GENERATE SCATTERING ANGLES AND UPDATE  LABORATORY COSINES AFTER
C   COLLISION ALSO UPDATE ENERGY OF ELECTRON.
C
  666 IPT=IARRY(I)
      ICOLL(IPT)=ICOLL(IPT)+1
      ICOLN(I)=ICOLN(I)+1
C IF EXCITATION THEN ADD PROBABILITY ,PENFRA(1,I),OF TRANSFER TO GIVE
C IONISATION OF THE OTHER GASES IN MIXTURE
      IF(IPEN.EQ.0.OR.NGAS.EQ.1) GO TO 5
      IF(PENFRA(1,I).NE.0.0) THEN
       RAN=drand48(RDUM)
       IF(RAN.GT.PENFRA(1,I)) GO TO 5
       NCLUS=NCLUS+1
C ENTER HERE POSSIBLE DELOCALISATION LENGTH FOR PENNING TRANSFER
       IF(PENFRA(2,I).EQ.0.0) THEN
        XS(NCLUS)=X
        YS(NCLUS)=Y
        ZS(NCLUS)=Z
        NFLGFC(NCLUS)=NFLGFF
        NFLGPPC(NCLUS)=NFLGPPP
        NFLGBRMC(NCLUS)=NFLGBRMM
        GO TO 667
       ENDIF
       ASIGN=1.0
       RAN=drand48(RDUM)
       RAN1=drand48(RDUM)
       IF(RAN1.LT.0.5) ASIGN=-ASIGN
       XS(NCLUS)=X-DLOG(RAN)*PENFRA(2,I)*ASIGN
       RAN=drand48(RDUM)
       RAN1=drand48(RDUM)
       IF(RAN1.LT.0.5) ASIGN=-ASIGN
       YS(NCLUS)=Y-DLOG(RAN)*PENFRA(2,I)*ASIGN
       RAN=drand48(RDUM)
       RAN1=drand48(RDUM)
       IF(RAN1.LT.0.5) ASIGN=-ASIGN
       ZS(NCLUS)=Z-DLOG(RAN)*PENFRA(2,I)*ASIGN
  667  RAN=drand48(RDUM)
       TS(NCLUS)=ST-DLOG(RAN)*PENFRA(3,I)
C ASSIGN EXCESS ENERGY OF 1EV TO PENNING CREATED ELECTRON
       ES(NCLUS)=1.0
       DCX(NCLUS)=DCX1
       DCY(NCLUS)=DCY1
       DCZ(NCLUS)=DCZ1
       GO TO 6
      ENDIF
C      GO TO 6
C CALCULATE SUM OF EXCITATION PER CLUSTER AND STORE EXCITATION X Y Z T
   5  IF(IPN(I).EQ.0) THEN
       IF((RGAS(I)*EIN(I)).GT.4.0) THEN
        KEXC=KEXC+1
        IF(KEXC.GT.150000) THEN
         WRITE(6,548) KEXC
 548     FORMAT(2X,' PROGRAM STOPPED . KEXC=',I7)
         STOP
        ENDIF
C FIND GAS IN WHICH EXCITATION OCCURED AND INCREMENT COUNTER
        IF(I.LE.IDG1) THEN
         NGEXC1=NGEXC1+1
        ELSE IF(I.LE.IDG2) THEN
         NGEXC2=NGEXC2+1
        ELSE IF(I.LE.IDG3) THEN
         NGEXC3=NGEXC3+1
        ELSE IF(I.LE.IDG4) THEN
         NGEXC4=NGEXC4+1
        ELSE IF(I.LE.IDG5) THEN
         NGEXC5=NGEXC5+1
        ELSE IF(I.LE.IDG6) THEN
         NGEXC6=NGEXC6+1
        ELSE
         WRITE(6,9911)
 9911    FORMAT(' PROGRAM STOPPED BAD GAS ID IN MONTE')
         STOP
        ENDIF
        NEXCTOT=NEXCTOT+1
        NSTEXC=NSTEXC+1
        XSTEXC(KEXC)=X
        YSTEXC(KEXC)=Y
        ZSTEXC(KEXC)=Z
        TSTEXC(KEXC)=ST
       ENDIF
      ENDIF
   6  S2=(S1*S1)/(S1-1.0D0)
C   ANISOTROPIC SCATTERING
      R3=drand48(RDUM)
      IF(INDEX(I).EQ.1) THEN
       R31=drand48(RDUM)
       F3=1.0D0-R3*ANGCT(IE,I)
       IF(R31.GT.PSCT(IE,I))  F3=-F3
      ELSE IF(INDEX(I).EQ.2) THEN
       EPSI=PSCT(IE,I)
       F3=1.0D0-(2.0D0*R3*(1.0D0-EPSI)/(1.0D0+EPSI*(1.0D0-2.0D0*R3)))
      ELSE
C ISOTROPIC SCATTERING
       F3=1.0D0-2.0D0*R3
      ENDIF
      THETA0=DACOS(F3)
      R4=drand48(RDUM)
      PHI0=F4*R4
      F8=DSIN(PHI0)
      F9=DCOS(PHI0)
      IF(E.LT.EI) EI=0.0D0
      ARG1=1.0D0-S1*EI/E
      ARG1=DMAX1(ARG1,SMALL)
      D=1.0D0-F3*DSQRT(ARG1)
      E1=E*(1.0D0-EI/(S1*E)-2.0D0*D/S2)
      E1=DMAX1(E1,SMALL)
      Q=DSQRT((E/E1)*ARG1)/S1
      Q=DMIN1(Q,1.0D0)
      THETA=DASIN(Q*DSIN(THETA0))
      F6=DCOS(THETA)
      U=(S1-1.0D0)*(S1-1.0D0)/ARG1
      CSQD=F3*F3
      IF(F3.LT.0.0D0.AND.CSQD.GT.U) F6=-1.0D0*F6
      F5=DSIN(THETA)
      DCZ2=DMIN1(DCZ2,1.0D0)
      ARGZ=DSQRT(DCX2*DCX2+DCY2*DCY2)
      IF(ARGZ.EQ.0.0D0) THEN
       DCZ1=F6
       DCX1=F9*F5
       DCY1=F8*F5
       IF(NTMPFLG.EQ.1) THEN
C USE FREE KINEMATICS FOR IONISATION SECONDARY ANGLES
        F5S=F5*DSQRT(E1/ES(NCLTMP))
        IF(F5S.GT.1.0) F5S=1.0
        THSEC=DASIN(F5S)
        F5S=DSIN(THSEC)
        F6S=DCOS(THSEC)
        IF(F6.LT.0.0) F6S=-F6S
        PHIS=PHI0+API
        IF(PHIS.GT.F4) PHIS=PHI0-F4
        F8S=DSIN(PHIS)
        F9S=DCOS(PHIS)
        DCZ(NCLTMP)=F6S
        DCX(NCLTMP)=F9S*F5S
        DCY(NCLTMP)=F8S*F5S
        NTMPFLG=0
       ENDIF
       GO TO 190
      ENDIF
      DCZ1=DCZ2*F6+ARGZ*F5*F8
      DCY1=DCY2*F6+(F5/ARGZ)*(DCX2*F9-DCY2*DCZ2*F8)
      DCX1=DCX2*F6-(F5/ARGZ)*(DCY2*F9+DCX2*DCZ2*F8)
      IF(NTMPFLG.EQ.1) THEN
C USE FREE KINEMATICS FOR IONISATION SECONDARY ANGLES
       F5S=F5*DSQRT(E1/ES(NCLTMP))
       IF(F5S.GT.1.0) F5S=1.0
       THSEC=DASIN(F5S)
       F5S=DSIN(THSEC)
       F6S=DCOS(THSEC)
       IF(F6.LT.0.0) F6S=-F6S
       PHIS=PHI0+API
       IF(PHIS.GT.F4) PHIS=PHI0-F4
       F8S=DSIN(PHIS)
       F9S=DCOS(PHIS)
       DCZ(NCLTMP)=DCZ2*F6S+ARGZ*F5S*F8S
       DCY(NCLTMP)=DCY2*F6S+(F5S/ARGZ)*(DCX2*F9S-DCY2*DCZ2*F8S)
       DCX(NCLTMP)=DCX2*F6S-(F5S/ARGZ)*(DCY2*F9S+DCX2*DCZ2*F8S)
       NTMPFLG=0
      ENDIF
  190 CONTINUE
C TEST IF ELECTRON IS THERMALISED
      IF(E1.GT.ETHRM) GO TO 1
C STORE POSITION AND TIME OF ELECTRON AND COLLISION HISTORY
  191 CONTINUE
      K1=K1+1
      XST(K1)=X
      YST(K1)=Y
      ZST(K1)=Z
      TST(K1)=ST
      NFGF(K1)=NFLGFF
      NFGPP(K1)=NFLGPPP
      NFGBR(K1)=NFLGBRMM
      TTIME(K1)=ST-TLAST
      NELEC=NELEC+1
      NETOT=NETOT+1
 335  IF(K1.EQ.150000) GO TO 889
C CATCH SINGLE ELECTRON CLUSTER THAT WAS ATTACHED.
c     IF(NELEC.EQ.1.AND.NCLUS.EQ.0) GO TO 210
C
        IF(NELEC.EQ.(NCLUS+1)) THEN
C       WRITE(6,884) NELEC,NCLUS,NEGION,J11
C 884 FORMAT(' NELEC=',I6,' NCLUS=',I6,' NEGION=',I3,' J11=',I6)
C LAST ELECTRON IN CLUSTER DO STATISTICS OVER PRIMARY CLUSTER
        CALL STATS(J11,J1)
        GO TO 210
       ENDIF
      IF(NELEC.LT.(NCLUS+1)) THEN
C GET NEW IONISATION ELECTRON FROM STORE
       X=XS(NELEC)
       Y=YS(NELEC)
       Z=ZS(NELEC)
       ST=TS(NELEC)
       NFLGFF=NFLGFC(NELEC)
       NFLGPPP=NFLGPPC(NELEC)
       NFLGBRMM=NFLGBRMC(NELEC)
       TLAST=TS(NELEC)
       E1=ES(NELEC)
       DCX1=DCX(NELEC)
       DCY1=DCY(NELEC)
       DCZ1=DCZ(NELEC)
       IF(E1.LT.ETHRM) GO TO 191
       GO TO 1
      ENDIF
C  MAIN LOOP END
  210 CONTINUE
C RESET NUMBER OF EVENTS FOR BAD EVENTS
      IF(IMIP.GT.2) NDELTA=NDELTA-IBADTOT
C
      WRITE(6,887) EMAX,NEOVFL
  887 FORMAT(' EMAX=',D12.7,' NEOVFL=',I5)
      IF(EMAX.GT.EFINAL) THEN
      WRITE(6,989) EFINAL,EMAX
  989 FORMAT('INCREASE ENERGY LIMIT FROM',D12.6,' EV TO AT LEAST',D12.6,
     /' EV.')
      STOP
      ENDIF
      RETURN
  889 NLEFT=NCLUS-NELEC
      WRITE(6,992) NPRIME,NLEFT,NCLUS
  992 FORMAT(3(/),' WARNING STOPPED AFTER NPRIME=',I6,' LAST PRIMARY HAS
     /AT LEAST ',I6,' SECONDARIES LEFT TO TRACK OUT OF ',I6,' ELECTRONS
     /ALREADY IN CLUSTER')
      STOP
      RETURN
      END


      double precision function realint(vector,wgt)
      implicit none
      include 'constants.f'
      include 'debug.f'
      include 'realonly.f'
      include 'virtonly.f'
      include 'noglue.f'
      include 'nflav.f'
      include 'vegas_common.f'
      include 'ptilde.f'
      include 'phasemin.f'
      include 'new_pspace.f'
      include 'npart.f'
      include 'scale.f'
      include 'facscale.f'
      include 'dynamicscale.f'
      include 'realwt.f'
      include 'efficiency.f'
      include 'maxwt.f'
      include 'process.f'
      include 'PDFerrors.f'
      include 'masses.f'
      include 'wts_bypart.f'
      include 'dipolescale.f'
      include 'stopscales.f'
      include 'flags.f'
      include 'frag.f'
      include 'ipsgen.f'
      include 'decay1q2a.f'
      include 'outputoptions.f'
      include 'breit.f'
      include 'dm_params.f'
      include 'outputflags.f'
      include 'runstring.f'
      include 'bypart.f'
      include 'energy.f'
      include 'incldip.f'
      include 'nproc.f'

c--- APPLgrid - enable grids
c      include 'APPLinclude.f'
c      include 'qcdcouple.f'
c      double precision psCR
c--- APPLgrid - end

c---- SSbegin
      include 'reweight.f'
c---- SSend
cz
cz //
      integer ih1,ih2,j,k,nd,nmax,nmin,nvec,ii,t
      double precision vector(mxdim),W,val,val2,valsum,xint,ptmp
      double precision fx1(-nf:nf),fx2(-nf:nf),
     . dipfx1(0:maxd,-nf:nf),dipfx2(0:maxd,-nf:nf),
     . fx1_H(-nf:nf),fx2_H(-nf:nf),fx1_L(-nf:nf),fx2_L(-nf:nf)
      double precision p(mxpart,4),pjet(mxpart,4),p1ext(4),p2ext(4)
      double precision pswt,rscalestart,fscalestart
      double precision s(mxpart,mxpart),wgt,msq(-nf:nf,-nf:nf)
      double precision msqa(-nf:nf,-nf:nf)
      double precision msqc(maxd,-nf:nf,-nf:nf),xmsq(0:maxd)
      double precision flux,BrnRat,xreal,xreal2
      double precision xx1,xx2,q(mxpart,4)
      double precision m3,m4,m5,R,Rbbmin
      double precision xmsq_bypart(0:maxd,-1:1,-1:1),xmsqjk,
     . plo(mxpart,4),pswtdip
      integer sgnj,sgnk
      common/xreal/xreal,xreal2
      common/Rbbmin/Rbbmin
      logical bin,first,failed
      logical includedipole,includereal
      double precision QandGint
      external qqb_w2jet_g,qqb_w2jet_gs,qqb_z2jet_g,qqb_z2jet_gs,
     . qqb_w2jet,qqb_w1jet_gs,qqb_z2jet,qqb_z1jet_gs,qqb_Hg_g,qqb_Hg_gs,
     . qqb_hww_g,qqb_hww_gs,qqb_zbb_g,qqb_zbb_gs,
     . qqb_wh_ww,qqb_wh_ww_gs,
     . qqb_wh_zz,qqb_wh_zz_gs,
     . qqb_wbb_g,qqb_wbb_gs,
     . qqb_dirgam_g,qqb_dirgam_gs,qqb_hflgam_g,qqb_hflgam_gs,
     . qqb_trigam_g,qqb_trigam_gs,qqb_gmgmjt_g,qqb_gmgmjt_gs,
     . qqb_w_g,qqb_w_gs,qqb_z1jet,qqb_z_gs,qqb_ww_g,qqb_ww_gs,
     . qqb_wz_g,qqb_wz_gs,qqb_zz_g,qqb_zz_gs,qqb_wgam_g,qqb_wgam_gs,
     . qqb_QQb_g,qqb_QQb_gs,
     . VV_Hqq_g,VV_Hqq_gs,VV_HWW_g,VV_HWW_gs,
     . gg_Hg,gg_H_gs,
     . gg_HWWgg,gg_HWWg_gs,gg_HZZgg,gg_HZZg_gs,
     . gg_Hgg,gg_Hg_gs,
     . gQ_zQ_g,gQ_zQ_gs,qqb_tbb_g,qqb_tbb_gs,
     . qqb_w_tndk_g,qqb_w_tndk_gs,
     . qqb_w_twdk_g,qqb_w_twdk_gs,qqb_w_twdk_gdk,qqb_w_twdk_gsdk,
     . qqb_zbjet_g,qqb_zbjet_gs,qqb_w_cjet_g,qqb_w_cjet_gs,
     . qqb_wbfromc_g,qqb_wbfromc_gs,
     . gg_hggg,gg_hgg_gs,qq_tchan_htqg,qq_tchan_htq_gs,
     . qg_tbq_g,qg_tbq_gs,qq_tbg_g,qq_tbg_gs,epem3j_g,epem3j_gs,
     . qq_tchan_ztqg_dk,qq_tchan_ztq_dk_gs,
     . qq_tchan_ztqg,qq_tchan_ztq_gs,
     . qqb_QQbdk_g,qqb_QQbdk_gs,qqb_gamgam_g,qqb_gamgam_gs,
     . qqb_zaj_gs,qqb_zaj_g,
     . qqb_gmgmjt_g_mad,
     . qqb_zaa_g,qqb_zaa_gs,
     . qqb_waa_g,qqb_waa_gs,
     . qqb_waa_g_mad,qqb_tottth_g,qqb_tottth_g_mad
      common/density/ih1,ih2
      common/bin/bin
      common/Pext/p1ext,p2ext
      common/nmax/nmax
      common/BrnRat/BrnRat
      common/nmin/nmin
cz Add b fraction
      double precision bwgt
      common/btagging/ bwgt
      double precision msqtmp(0:maxd),bwgttmp(0:maxd)
      double precision realeventp(mxpart,4)
      common/realeventp/realeventp

      data bwgt / 0d0 /  ! in common block
cz // Add b fraction   Note: only msqtmp(0), bwgttmp(0) are used in nplotter.f
!      data p/56*0d0/
      data first/.true./
      save first,rscalestart,fscalestart
!$omp threadprivate(/pext/,first,rscalestart,fscalestart)

      QandGflag=.false.
      p(:,:)=0d0

      if (first) then
         first=.false.
         rscalestart=scale
         fscalestart=facscale
      endif
      ntotshot=ntotshot+1
      pswt=0d0
      realint=0d0
c--- ensure isolation code does not think this is fragmentation piece
      z_frag=0d0

      W=sqrts**2

c      if (first) then
c         write(6,*)
c         write(6,*) 'nmin=',nmin,',nmax=',nmax
c         write(6,*)
c         first=.false.
c      endif

c-- note: new_pspace now signifies multi-channel integration
      if (new_pspace) then
        call gen_lops(vector,plo,pswt,*999)
!        call writeout(plo)
        npart=npart+1
        call multichan(vector(ndim-2),vector(ndim-1),vector(ndim),
     &                 vector(ndim+2),plo,p,pswtdip,*999)
!        call writeout(p)
!        pause
        pswt=pswt*pswtdip
      else
        call gen_realps(vector,p,pswt,*999)
      endif

      nvec=npart+2
      call dotem(nvec,p,s)

c----calculate the x's for the incoming partons from generated momenta

      xx1=two*(p(1,4)*p2ext(4)-p(1,3)*p2ext(3))/W
      xx2=two*(p(2,4)*p1ext(4)-p(2,3)*p1ext(3))/W

      if (debug) write(*,*) 'Reconstructed x1,x2 ',xx1,xx2

      if ((xx1 .gt.  1d0) .or. (xx2 .gt.  1d0)
     &.or.(xx1 .lt. xmin) .or. (xx2 .lt. xmin)) then
         goto 999
      endif

c--- (moved to includedipole) impose cuts on final state
c      call masscuts(p,*999)

c----reject event if any s(i,j) is too small
      call smalls(s,npart,*999)

c--- extra cut to divide WQj/ZQj regions
      if ( (nproc .eq. 312) .or. (nproc .eq. 317)
     . .or.(nproc .eq. 322) .or. (nproc .eq. 327)
     . .or.(nproc .eq. 342) .or. (nproc .eq. 352)) then
        if (R(p,5,6) .lt. Rbbmin) goto 999
      endif

c--- see whether this point will pass cuts - if it will not, do not
c--- bother calculating the matrix elements for it, instead set to zero
      includereal=includedipole(0,p)
      incldip(0)=includereal

      if (includereal .eqv. .false.) then
        do j=-nf,nf
        do k=-nf,nf
          msq(j,k)=0d0
          msqLH(j,k)=0d0   ! for stop+b process
          msqHL(j,k)=0d0   ! for stop+b process
        enddo
        enddo
      endif

      do j=1,mxpart
      do k=1,4
        realeventp(j,k)=p(j,k)
      enddo
      enddo

c--- test to see whether we need Gflag and Qflag together
      if ( ((case .eq. 'W_2jet') .or. (case .eq. 'Z_2jet'))
     &.and. (Qflag) .and. (Gflag) ) then
        QandGflag=.true.
        QandGint=0d0
c--- first pass: Gflag
        Gflag=.true.
        Qflag=.false.
      endif

c--- restart from here when calculating with Qflag and Gflag
c--- (W+2 jet and Z+2 jet processes only)
   44 continue

      if (dynamicscale) then
        call scaleset(rscalestart,fscalestart,p)
        dipscale(0)=facscale
      endif

c---- generate collinear points that satisfy the jet cuts (for checking)
c      call singgen(p,s,*998)

c--- Calculate the required matrix elements
      if     (case .eq. 'W_only') then
c        call singcheck(qqb_w_g,qqb_w_gs,p)         ! Checked 11/30/01
        if (includereal) call qqb_w_g(p,msq)
        call qqb_w_gs(p,msqc)
      elseif (case .eq. 'W_1jet') then
c        call singcheck(qqb_w2jet,qqb_w1jet_gs,p)   ! Checked 11/16/01
        if (includereal) call qqb_w2jet(p,msq)
        call qqb_w1jet_gs(p,msqc)
      elseif (case .eq. 'Wgamma') then
!         if(includereal) call singcheck(qqb_wgam_g,qqb_wgam_gs,p) ! Checked 08/27/02
        if (includereal) call qqb_wgam_g(p,msq)
        call qqb_wgam_gs(p,msqc)
      elseif (case .eq. 'Wbfrmc') then
        if (includereal) call qqb_wbfromc_g(p,msq)
        call qqb_wbfromc_gs(p,msqc)
      elseif (case .eq. 'W_cjet') then
c        call singcheck(qqb_w_cjet_g,qqb_w_cjet_gs,p) ! Checked 15/05/07
        if (includereal) call qqb_w_cjet_g(p,msq)
        call qqb_w_cjet_gs(p,msqc)
      elseif (case .eq. 'Zgamma') then
!         if(includereal) call singcheck(qqb_zgam_g,qqb_zgam_gs,p) ! Checked 01/04/11
        if (includereal) call qqb_zgam_g(p,msq)
        call qqb_zgam_gs(p,msqc)
      elseif (case .eq. 'Z_2gam') then
c         if(includereal) call singcheck(qqb_zaa_g,qqb_zaa_gs,p)
        if (includereal) call qqb_zaa_g(p,msq)
        call qqb_zaa_gs(p,msqc)
      elseif (case .eq. 'W_2gam') then
c        if(includereal) call singcheck(qqb_waa_g,qqb_waa_gs,p)
c        call compare_madgraph(p,qqb_waa_g,qqb_waa_g_mad)
         stop
c        if (includereal) call qqb_waa_g(p,msq)
c        call qqb_waa_gs(p,msqc)
      elseif (case .eq. 'Zgajet') then
!        if(includereal) call singcheck(qqb_zaj_g,qqb_zaj_gs,p)     ! Checked 10/21/10
        if (includereal) call qqb_zaj_g(p,msq)
        call qqb_zaj_gs(p,msqc)
      elseif (case .eq. 'Wbbmas') then
c        call singcheck(qqb_wbbm_g,qqb_wbbm_gs,p)     ! Checked 10/21/10
      if (includereal) call qqb_wbbm_g(p,msq)
        call qqb_wbbm_gs(p,msqc)
      elseif (case .eq. 'Wttmas') then
c        call singcheck(qqb_wbbm_g,qqb_wbbm_gs,p)     ! Checked 10/21/10
      if (includereal) call qqb_wbbm_g(p,msq)
        call qqb_wbbm_gs(p,msqc)
      elseif (case .eq. 'Wbbbar') then
c        call singcheck(qqb_wbb_g,qqb_wbb_gs,p)     ! Checked 11/30/01
        if (includereal) call qqb_wbb_g(p,msq)
        call qqb_wbb_gs(p,msqc)
      elseif (case .eq. 'W_2jet') then
c        call singcheck(qqb_w2jet_g,qqb_w2jet_gs,p) ! Re-checked June 09
        if (includereal)  call qqb_w2jet_g(p,msq)
        call qqb_w2jet_gs(p,msqc)
      elseif (case .eq. 'Z_only') then
c        call singcheck(qqb_z1jet,qqb_z_gs,p)         ! Checked 11/30/01
        if (includereal) call qqb_z1jet(p,msq)
        call qqb_z_gs(p,msqc)
      elseif (case .eq. 'Z_1jet') then
c        call singcheck(qqb_z2jet,qqb_z1jet_gs,p)   ! Checked 11/16/01
        if (includereal) call qqb_z2jet(p,msq)
        call qqb_z1jet_gs(p,msqc)
      elseif (case .eq. 'Z_2jet') then
c        call singcheck(qqb_z2jet_g,qqb_z2jet_gs,p) ! Re-checked June 09
        if (includereal) call qqb_z2jet_g(p,msq)
        call qqb_z2jet_gs(p,msqc)
      elseif (case .eq. 'Zbbbar') then
c        call singcheck(qqb_zbb_g,qqb_zbb_gs,p)     ! Checked 11/30/01
        if (includereal) call qqb_zbb_g(p,msq)
        call qqb_zbb_gs(p,msqc)
      elseif (case .eq. 'WWqqbr') then
c        call singcheck(qqb_ww_g,qqb_ww_gs,p)       ! Checked 11/30/01
        if (includereal) call qqb_ww_g(p,msq)
        call qqb_ww_gs(p,msqc)
      elseif (case .eq. 'WWqqdk') then
        if (includereal) call dkqqb_ww_g(p,msq)
        call dkqqb_ww_gs(p,msqc)
      elseif (case .eq. 'WZbbar') then
c        call singcheck(qqb_wz_g,qqb_wz_gs,p)       ! Checked 12/05/01
        if (includereal) call qqb_wz_g(p,msq)
        call qqb_wz_gs(p,msqc)
      elseif (case .eq. 'ZZlept') then
c        call singcheck(qqb_zz_g,qqb_zz_gs,p)       ! Checked 12/05/01
        if (includereal) call qqb_zz_g(p,msq)
        call qqb_zz_gs(p,msqc)
      elseif (case .eq. 'WHbbar') then
c        call singcheck(qqb_wh_g,qqb_wh_gs,p)
        if (includereal) call qqb_wh_g(p,msq)
        call qqb_wh_gs(p,msqc)
      elseif (case .eq. 'WH__WW') then
c        call singcheck(qqb_wh_ww_g,qqb_wh_ww_gs,p)
        if (includereal) call qqb_wh_ww_g(p,msq)
        call qqb_wh_ww_gs(p,msqc)
      elseif (case .eq. 'WH__ZZ') then
c        call singcheck(qqb_wh_zz_g,qqb_wh_zz_gs,p)
        if (includereal) call qqb_wh_zz_g(p,msq)
        call qqb_wh_zz_gs(p,msqc)
      elseif (case .eq. 'WHgaga') then
c        call singcheck(qqb_wh_gaga_g,qqb_wh_gaga_gs,p)
        if (includereal) call qqb_wh_gaga_g(p,msq)
        call qqb_wh_gaga_gs(p,msqc)
      elseif (case .eq. 'ZHbbar') then
c        call singcheck(qqb_zh_g,qqb_zh_gs,p)
        if (includereal) call qqb_zh_g(p,msq)
        call qqb_zh_gs(p,msqc)
      elseif (case .eq. 'ZHgaga') then
c        call singcheck(qqb_zh_gaga_g,qqb_zh_gaga_gs,p)
        if (includereal) call qqb_zh_gaga_g(p,msq)
        call qqb_zh_gaga_gs(p,msqc)
      elseif (case .eq. 'ZH__WW') then
c        call singcheck(qqb_zh_ww_g,qqb_zh_ww_gs,p)
        if (includereal) call qqb_zh_ww_g(p,msq)
        call qqb_zh_ww_gs(p,msqc)
      elseif (case .eq. 'ZH__ZZ') then
c        call singcheck(qqb_zh_zz_g,qqb_zh_zz_gs,p)
        if (includereal) call qqb_zh_zz_g(p,msq)
        call qqb_zh_zz_gs(p,msqc)
      elseif (case .eq. 'dirgam') then
!        if (includereal) call singcheck(qqb_dirgam_g,qqb_dirgam_gs,p)
        if (includereal) call qqb_dirgam_g(p,msq)
        call qqb_dirgam_gs(p,msqc)
      elseif (case .eq. 'hflgam') then
c        if (includereal) call singcheck(qqb_hflgam_g,qqb_hflgam_gs,p)
        if (includereal) call qqb_hflgam_g(p,msq)
        call qqb_hflgam_gs(p,msqc)
      elseif (case .eq. 'gamgam') then
c        if (includereal) call singcheck(qqb_gamgam_g,qqb_gamgam_gs,p)
        if (includereal) call qqb_gamgam_g(p,msq)
        call qqb_gamgam_gs(p,msqc)
      elseif (case .eq. 'gmgmjt') then
c        if (includereal) call singcheck(qqb_gmgmjt_g,qqb_gmgmjt_gs,p)
        if (includereal) call qqb_gmgmjt_g(p,msq)
        call qqb_gmgmjt_gs(p,msqc)
      elseif (case .eq. 'trigam') then
c        if (includereal) call singcheck(qqb_trigam_g,qqb_trigam_gs,p)
        if (includereal) call qqb_trigam_g(p,msq)
        call qqb_trigam_gs(p,msqc)
      elseif (case.eq.'fourga') then
c        if (includereal) call singcheck(qqb_fourgam_g,qqb_fourgam_gs,p)
        if (includereal) call qqb_fourgam_g(p,msq)
        call qqb_fourgam_gs(p,msqc)
       elseif (case .eq. 'ggfus0') then
c         call singcheck(gg_hg,gg_h_gs,p)       ! Checked 28/02/03
         if (includereal) call gg_hg(p,msq)
         call gg_h_gs(p,msqc)
       elseif (case .eq. 'Higaga') then
c         call singcheck(gg_hgamgamg,gg_hgamgam_gs,p)
         if (includereal) call gg_hgamgamg(p,msq)
         call gg_hgamgam_gs(p,msqc)
       elseif (case .eq. 'Hi_Zga') then
c         call singcheck(gg_hzgamg,gg_hzgam_gs,p)
         if (includereal) call gg_hzgamg(p,msq)
         call gg_hzgam_gs(p,msqc)
      elseif ((case .eq. 'HWW_4l') .or. (case .eq. 'HWW2lq')) then
c        call singcheck(qqb_hww_g,qqb_hww_gs,p)
        if (includereal) call qqb_hww_g(p,msq)
        call qqb_hww_gs(p,msqc)
      elseif (case .eq. 'HWWdkW') then
        if (includereal) call dkqqb_hww_g(p,msq)
        call dkqqb_hww_gs(p,msqc)
      elseif (case .eq. 'HWWdkW') then
        if (includereal) call dkqqb_hww_g(p,msq)
        call dkqqb_hww_gs(p,msqc)
      elseif (case .eq. 'HZZ_4l') then
c        call singcheck(qqb_hzz_g,qqb_hzz_gs,p)
        if (includereal) call qqb_hzz_g(p,msq)
        call qqb_hzz_gs(p,msqc)
      elseif (case .eq. 'H_1jet') then
c        call singcheck(qqb_Hg_g,qqb_Hg_gs,p)       ! Checked 19/02/02
        if (includereal) call qqb_Hg_g(p,msq)
        call qqb_Hg_gs(p,msqc)
      elseif ((case .eq. 'tt_bbl') .or. (case .eq. 'tt_bbh')) then
c         call singcheck(qqb_QQbdk_g,qqb_QQbdk_gs,p) ! Checked 15/8/08
        if (includereal) call qqb_QQbdk_g(p,msq)
        call qqb_QQbdk_gs(p,msqc)
      elseif ((case .eq. 'tt_ldk') .or. (case .eq. 'tt_hdk')) then
        if     (decay1q2a .eq. 1) then
c------ radiation in the decay of the top quark
        if (includereal) call dk1qqb_QQb_g(p,msq)
          call dk1qqb_QQb_gs(p,msqc)
      elseif (decay1q2a .eq. 2) then
c------ radiation in the decay of the anti-top quark
        if (includereal) call dk2qqb_QQb_g(p,msq)
          call dk2qqb_QQb_gs(p,msqc)
      else
        write(6,*) 'Problem generating PS, decay1q2a=',decay1q2a
        stop
      endif
      elseif (case .eq. 'tt_udk') then
        if     (decay1q2a .eq. 1) then
c------ radiation in the decay of the top quark
        if (includereal) call dk1uqqb_QQb_g(p,msq)
          call dk1uqqb_QQb_gs(p,msqc)
      elseif (decay1q2a .eq. 2) then
c------ radiation in the decay of the anti-top quark
        if (includereal) call dk2uqqb_QQb_g(p,msq)
          call dk2uqqb_QQb_gs(p,msqc)
      else
        write(6,*) 'Problem generating PS, decay1q2a=',decay1q2a
        stop
      endif
      elseif (case .eq. 'tthWdk') then
        if     (decay1q2a .eq. 1) then
c------ radiation in the decay of the top quark
        if (includereal) call dkW1qqb_QQb_g(p,msq)
          call dkW1qqb_QQb_gs(p,msqc)
      elseif (decay1q2a .eq. 2) then
c------ radiation in the decay of the anti-top quark
        if (includereal) call dkW2qqb_QQb_g(p,msq)
          call dkW2qqb_QQb_gs(p,msqc)
      else
        write(6,*) 'Problem generating PS, decay1q2a=',decay1q2a
        stop
      endif
      elseif (case .eq. 'tt_bbu') then
c         call singcheck(qqb_QQbdku_g,qqb_QQbdku_gs,p) !
c         pause
        if (includereal) call qqb_QQbdku_g(p,msq)
        call qqb_QQbdku_gs(p,msqc)
      elseif ((case .eq. 'tt_tot') .or. (case .eq. 'cc_tot')
     .   .or. (case .eq. 'bb_tot')) then
c        call singcheck(qqb_QQb_g,qqb_QQb_gs,p)
        if (includereal) call qqb_QQb_g(p,msq)
        call qqb_QQb_gs(p,msqc)
      elseif (case .eq. 'bq_tpq') then
c        call singcheck(qqb_tbb_g,qqb_tbb_gs,p)
        if (includereal) call qqb_tbb_g(p,msq)
        call qqb_tbb_gs(p,msqc)
      elseif (case .eq. 't_bbar') then
c        call singcheck(qqb_tbb_g,qqb_tbb_gs,p)
        if (includereal) call qqb_tbbdk_g(p,msq)
        call qqb_tbbdk_gs(p,msqc)
      elseif (case .eq. 'ttdkay') then
c        call singcheck(qqb_tbb_g_new,qqb_tbb_gs,p)
        if (includereal) call bq_tpq_gdk(p,msq)
        call bq_tpq_gsdk(p,msqc)
      elseif (case .eq. 'tdecay') then
c        call singcheck(qqb_tbb_g_new,qqb_tbb_gs,p)
      if (includereal) call dkqqb_tbbdk_g(p,msq)
        call dkqqb_tbbdk_gs(p,msqc)
       elseif (case .eq. 'W_tndk') then
c        call singcheck(qqb_w_tndk_g,qqb_w_tndk_gs,p)      ! Checked 12/3/04
        if (includereal) call qqb_w_tndk_g(p,msq)
        call qqb_w_tndk_gs(p,msqc)
      elseif (case .eq. 'W_twdk') then
c        call singcheck(qqb_w_twdk_g,qqb_w_twdk_gs,p)            ! Checked 2/4/05
        if (includereal) call qqb_w_twdk_g(p,msq)
        call qqb_w_twdk_gs(p,msqc)
      elseif (case .eq. 'Wtdkay') then
        if (includereal) call dkqqb_w_twdk_g(p,msq)
        call dkqqb_w_twdk_gs(p,msqc)
      elseif ( (case .eq. 'qq_ttw')) then
        if (includereal) call qqb_ttw_g(p,msq)
        call qqb_ttw_gs(p,msqc)
      elseif ( (case .eq. 'ttwldk')) then
        if     (decay1q2a .eq. 1) then
c------ radiation in the decay of the top quark
        if (includereal) call dk1qqb_ttw_g(p,msq)
          call dk1qqb_ttw_gs(p,msqc)
      elseif (decay1q2a .eq. 2) then
c------ radiation in the decay of the anti-top quark
        if (includereal) call dk2qqb_ttw_g(p,msq)
          call dk2qqb_ttw_gs(p,msqc)
      else
        write(6,*) 'Problem generating PS, decay1q2a=',decay1q2a
        stop
      endif
      elseif (case .eq. 'ggfus1') then
c        call singcheck(gg_hgg,gg_hg_gs,p)
        if (includereal) call gg_hgg(p,msq)
        call gg_hg_gs(p,msqc)
      elseif (case .eq. 'Hgagaj') then
c        call singcheck(gg_hgagagg,gg_hgagag_gs,p)
        if (includereal) call gg_hgagagg(p,msq)
        call gg_hgagag_gs(p,msqc)
      elseif (case .eq. 'HWWjet') then
c        call singcheck(gg_hWWgg,gg_hWWg_gs,p)
        if (includereal) call gg_hWWgg(p,msq)
        call gg_hWWg_gs(p,msqc)
      elseif (case .eq. 'HWW2jt') then
c        call singcheck(gg_hWWgg,gg_hWWg_gs,p)
        if (includereal) call gg_hWWggg(p,msq)
        call gg_hWWgg_gs(p,msqc)
      elseif (case .eq. 'HZZjet') then
c        call singcheck(gg_hZZgg,gg_hZZg_gs,p)
        if (includereal) call gg_hZZgg(p,msq)
        call gg_hZZg_gs(p,msqc)
      elseif (case .eq. 'HZZ2jt') then
c        call singcheck(gg_hZZgg,gg_hZZg_gs,p)
        if (includereal) call gg_hZZggg(p,msq)
        call gg_hZZgg_gs(p,msqc)
c      write(6,*) msq
c      pause
      elseif (case .eq. 'qq_Hqq') then
c        call singcheck(VV_Hqq_g,VV_Hqq_gs,p)
        if (includereal) call VV_Hqq_g(p,msq)
        call VV_Hqq_gs(p,msqc)
      elseif (case .eq. 'qq_Hgg') then
c        call singcheck(VV_Hgaga_g,VV_Hgaga_gs,p)
        if (includereal) call VV_Hgaga_g(p,msq)
        call VV_Hgaga_gs(p,msqc)
      elseif (case .eq. 'qq_HWW') then
c        call singcheck(VV_HWW_g,VV_HWW_gs,p)
        if (includereal) call VV_HWW_g(p,msq)
        call VV_HWW_gs(p,msqc)
      elseif (case .eq. 'qq_HZZ') then
c        call singcheck(VV_HZZ_g,VV_HZZ_gs,p)
        if (includereal) call VV_HZZ_g(p,msq)
        call VV_HZZ_gs(p,msqc)
      elseif (case .eq. 'ggfus2') then
c        call singcheck(gg_hggg,gg_hgg_gs,p)            ! Checked 10/29/09
        if (includereal) call gg_hggg(p,msq)
        call gg_hgg_gs(p,msqc)
      elseif (case .eq. 'gagajj') then
c        call singcheck(gg_hggg,gg_hgg_gs,p)
        if (includereal) call gg_hggg(p,msq)
        call gg_hgg_gs(p,msqc)
      elseif (case .eq. 'qg_tbq') then
c        call singcheck(qg_tbq_g,qg_tbq_gs,p)       ! Checked 2/4/08
       if (includereal) call qg_tbq_g(p,msq)
       call qg_tbq_gs(p,msqc)
      elseif (case .eq. '4ftwdk') then
c        call singcheck(qg_tbq_g,qg_tbq_gs,p)
       if (includereal) call qg_tbqdk_g(p,msq)
       call qg_tbqdk_gs(p,msqc)
      elseif (case .eq. 'dk_4ft') then
c       if (includereal) call dkqg_tbqdk_g_old(p,msq)
       if (includereal) call dkqg_tbqdk_g(p,msq)
       call dkqg_tbqdk_gs(p,msqc)
      elseif (case .eq. 'qq_tbg') then
c        call singcheck(qq_tbg_g,qq_tbg_gs,p)       ! Checked 8/9/08
       if (includereal) call qq_tbg_g(p,msq)
       call qq_tbg_gs(p,msqc)
      elseif (case .eq. 'epem3j') then
c        call singcheck(epem3j_g,epem3j_gs,p)       ! Checked 17/11/08
       if (includereal) call epem3j_g(p,msq)
       call epem3j_gs(p,msqc)
      elseif (case .eq. 'gQ__ZQ') then
c        call singcheck(gQ_zQ_g,gQ_zQ_gs,p)
        if (includereal) call gQ_zQ_g(p,msq)
        call gQ_zQ_gs(p,msqc)
      elseif (case .eq. 'Z_bjet') then
c        call singcheck(qqb_zbjet_g,qqb_zbjet_gs,p)      ! Checked 07/18/05
        if (includereal) call qqb_zbjet_g(p,msq)
        call qqb_zbjet_gs(p,msqc)
      elseif (case .eq. 'W_bjet') then
c        call singcheck(qqb_wbjet_g,qqb_wbjet_gs,p) ! Rechecked 14/3/08
        if (includereal) call qqb_wbjet_g(p,msq)
        call qqb_wbjet_gs(p,msqc)
      elseif (case .eq. 'Wcsbar') then
c        call singcheck(qqb_w_g,qqb_w_gs,p)         ! Checked 11/30/01
        if (includereal) call qqb_w_g(p,msq)
        call qqb_w_gs(p,msqc)
      elseif (case .eq. 'Wcs_ms') then
        if (includereal) call qqb_w_cjet(p,msq)
        ndmax=0
      elseif (case .eq. 'Z_tjet') then
c        if (includereal) call singcheck(qq_tchan_ztqg,qq_tchan_ztq_gs,p)
        if (includereal) call qq_tchan_ztqg(p,msq)
        call qq_tchan_ztq_gs(p,msqc)
      elseif (case .eq. 'Z_tdkj') then
c        if (includereal) call singcheck(qq_tchan_ztqg_dk,
c     &                                  qq_tchan_ztq_dk_gs,p)
        if (includereal) call qq_tchan_ztqg_dk(p,msq)
        call qq_tchan_ztq_dk_gs(p,msqc)
      elseif (case .eq. 'H_tjet') then
c        if (includereal) call singcheck(qq_tchan_htqg,qq_tchan_htq_gs,p)
        if (includereal) call qq_tchan_htqg(p,msq)
        call qq_tchan_htq_gs(p,msqc)
      elseif (case .eq. 'H_tdkj') then
        if (includereal) call qq_tchan_htqg_dk(p,msq)
        call qq_tchan_htq_dk_gs(p,msqc)
      elseif (case .eq. 'tottth') then
c        if (includereal) call qqb_tottth_g(p,msq)
c        call qqb_tottth_gs(p,msqsc)
c        call singcheck(qqb_tottth_g,qqb_tottth_gs,p)
c        call compare_madgraph(p,qqb_tottth_g,qqb_tottth_g_mad)
      elseif (case .eq. 'dm_jet') then
         if(includereal) call qqb_dm_monojet_g(p,msq)
         call qqb_dm_monojet_gs(p,msqc)
      elseif (case.eq.'dm_gam') then
!         if(includereal) call singcheck(qqb_dm_monophot_g
!     &        ,qqb_dm_monophot_gs,p)
         if(includereal) call qqb_dm_monophot_g(p,msq)
         call qqb_dm_monophot_gs(p,msqc)

      endif

      do nd=0,ndmax
      xmsq(nd)=0d0
cz
      msqtmp(nd)=0d0
      bwgttmp(nd)=0d0
cz //
      do j=-1,1
      do k=-1,1
      xmsq_bypart(nd,j,k)=0d0
      enddo
      enddo
      enddo

      currentPDF=0

      flux=fbGeV2/(two*xx1*xx2*W)
c--- for mlm study, divide by (Ecm)**2=W
c      if (runstring(1:3) .eq. 'mlm') then
c      flux=flux/W
c      endif

c--- initialize a PDF set here, if calculating errors
  777 continue
      do nd=0,ndmax
      xmsq(nd)=0d0
cz
      msqtmp(nd)=0d0
      bwgttmp(nd)=0d0
cz //
      enddo
      if (PDFerrors) then
        call InitPDF(currentPDF)
      endif

c--- calculate PDF's
      if (dynamicscale) then
        do nd=ndmax,0,-1  ! so that fx1,fx2 correct for real kinematics
          if (dipscale(nd) .lt. 1d-8) then
c--- in case dipole is not used, set up dummy value of scale for safety
c--- and set all PDF entries to zero
          dipscale(nd)=dipscale(0)
          do j=-nf,nf
            fx1(j)=0d0
            fx2(j)=0d0
          enddo
        else
            call fdist(ih1,xx1,dipscale(nd),fx1)
            call fdist(ih2,xx2,dipscale(nd),fx2)
            do j=-nf,nf
            dipfx1(nd,j)=fx1(j)
            dipfx2(nd,j)=fx2(j)
          enddo
        endif
      enddo
        if ((case .eq. 'qg_tbq') .or. (case .eq. '4ftwdk')) then
        do j=-nf,nf
        fx1_H(j)=fx1(j)
        fx1_L(j)=fx1(j)
        fx2_H(j)=fx2(j)
        fx2_L(j)=fx2(j)
        enddo
      endif
      else
        if ((case .eq. 'qg_tbq') .or. (case .eq. '4ftwdk')) then
c--- for single top + b, make sure to use two different scales
          call fdist(ih1,xx1,facscale_H,fx1_H)
          call fdist(ih2,xx2,facscale_H,fx2_H)
          call fdist(ih1,xx1,facscale_L,fx1_L)
          call fdist(ih2,xx2,facscale_L,fx2_L)
        do j=-nf,nf
          if (j .eq. 0) then  ! heavy quark line has gluon init. state
            fx1(j)=fx1_H(j)
            fx2(j)=fx2_H(j)
          else
            fx1(j)=fx1_L(j)
            fx2(j)=fx2_L(j)
          endif
        enddo
        else
c--- for comparison with C. Oleari's e+e- --> QQbg calculation
c            if (runstring(1:5) .eq. 'carlo') then
c            flux=1d0/2d0/W/(as/twopi)**2
c--- divide out by (ason2pi) and then the "LO" massless DY process
c          flux=flux/(aveqq*xn*fourpi*(gwsq/fourpi)**2/3d0/sqrts**2)
c            flux=flux/(xn/8d0)
c          do j=-nf,nf
c          fx1(j)=0d0
c          fx2(j)=0d0
c          enddo
c          fx1(0)=1d0
c          fx1(1)=1d0
c          fx2(0)=1d0
c          fx2(1)=1d0
c          else
c--- usual case
            call fdist(ih1,xx1,facscale,fx1)
            call fdist(ih2,xx2,facscale,fx2)
c        endif
        endif
      endif

      do j=-nflav,nflav
      do k=-nflav,nflav

      if (ggonly) then
      if ((j.ne.0) .or. (k.ne.0)) goto 20
      endif

      if (gqonly) then
      if (((j.eq.0).and.(k.eq.0)) .or. ((j.ne.0).and.(k.ne.0))) goto 20
      endif

      if (noglue) then
      if ((j.eq.0) .or. (k.eq.0)) goto 20
      endif

      if (omitgg) then
      if ((j.eq.0) .and. (k.eq.0)) goto 20
      endif

      if ((case .eq. 'Wcsbar').and.(j .ne. 4).and.(k .ne. 4)) goto 20

      if (realonly) then
        xmsq(0)=xmsq(0)+fx1(j)*fx2(k)*msq(j,k)
        do nd=1,ndmax
        xmsq(nd)=0d0
        enddo
      elseif (virtonly) then
         xmsq(0)=0d0
         do nd=1,ndmax
         if (dynamicscale) then
             xmsq(nd)=xmsq(nd)+dipfx1(nd,j)*dipfx2(nd,k)*(-msqc(nd,j,k))
         else
             xmsq(nd)=xmsq(nd)+fx1(j)*fx2(k)*(-msqc(nd,j,k))
         endif
         enddo
      else

         if     (j .gt. 0) then
           sgnj=+1
         elseif (j .lt. 0) then
           sgnj=-1
         else
           sgnj=0
         endif
         if     (k .gt. 0) then
           sgnk=+1
         elseif (k .lt. 0) then
           sgnk=-1
         else
           sgnk=0
         endif

c--- for single top + b, make sure to use two different scales
         if ((case .eq. 'qg_tbq') .or. (case .eq. '4ftwdk')) then
           xmsqjk=fx1_L(j)*fx2_H(k)*msqLH(j,k)
     .           +fx1_H(j)*fx2_L(k)*msqHL(j,k)
         else
c--- usual case
           xmsqjk=fx1(j)*fx2(k)*msq(j,k)
       endif

         xmsq(0)=xmsq(0)+xmsqjk
cz
cz Extract fraction with b in final state, store in common
cz
c     nproc=161 then t-channel: t
c     isub = 1, nwz = 1
         if (nproc.eq.161) then ! t
            msqtmp(0)=msqtmp(0)+xmsqjk
            if ((j.eq.0).and.((k.lt.0).or.((k.gt.0).and.
     &           (k.ne.5)))) then
               bwgttmp(0)=bwgttmp(0)+xmsqjk
            endif
            if ((k.eq.0).and.((j.lt.0).or.((j.gt.0).and.
     &           (j.ne.5)))) then
               bwgttmp(0)=bwgttmp(0)+xmsqjk
            endif
         endif
c     nproc=166 then t-channel: t~
         if (nproc.eq.166) then ! t
            msqtmp(0)=msqtmp(0)+xmsqjk
            if ((j.eq.0).and.((k.gt.0).or.((k.lt.0).and.
     &           (k.ne.-5)))) then
               bwgttmp(0)=bwgttmp(0)+xmsqjk
            endif
            if ((k.eq.0).and.((j.gt.0).or.((j.lt.0).and.
     &           (j.ne.-5)))) then
               bwgttmp(0)=bwgttmp(0)+xmsqjk
            endif
         endif
cz // end fill index 0

         if (currentPDF .eq. 0) then
           xmsq_bypart(0,sgnj,sgnk)=xmsq_bypart(0,sgnj,sgnk)+xmsqjk
         endif
         do nd=1,ndmax
         if (dynamicscale) then
             xmsqjk=dipfx1(nd,j)*dipfx2(nd,k)*(-msqc(nd,j,k))
         else
             xmsqjk=fx1(j)*fx2(k)*(-msqc(nd,j,k))
         endif
           xmsq(nd)=xmsq(nd)+xmsqjk
           if (currentPDF .eq. 0) then
             xmsq_bypart(nd,sgnj,sgnk)=xmsq_bypart(nd,sgnj,sgnk)+xmsqjk
           endif
         enddo

      endif
 20   continue

      enddo
      enddo

c--- loop over all PDF error sets, if necessary
      if (PDFerrors) then
        do nd=0,ndmax
          PDFxsec_nd(currentPDF,nd)=xmsq(nd)
        enddo
        currentPDF=currentPDF+1
        if (currentPDF .le. maxPDFsets) goto 777
c--- reset xmsq to the central PDF values
        do nd=0,ndmax
          xmsq(nd)=PDFxsec_nd(0,nd)
        enddo
      endif

      realint=0d0
      xint=0d0
cz
      bwgt=0d0
cz //

      valsum=0d0 ! running total of weights at this point

c--- zero out temporary histograms
c      if (bin) call zerorealhistos
      if (bin) call smartzero

c---trial with weight of real alone
c---first set up all dipole contributions
c---this is the value of integral including subtractions
      do nd=0,ndmax
        xmsq(nd)=xmsq(nd)*flux*pswt/BrnRat
c        if (creatent) then
          wt_gg=xmsq_bypart(nd,0,0)*wgt*flux*pswt/BrnRat/dfloat(itmx)
          wt_gq=(xmsq_bypart(nd,+1,0)+xmsq_bypart(nd,-1,0)
     .          +xmsq_bypart(nd,0,+1)+xmsq_bypart(nd,0,-1)
     .          )*wgt*flux*pswt/BrnRat/dfloat(itmx)
          wt_qq=(xmsq_bypart(nd,+1,+1)+xmsq_bypart(nd,-1,-1)
     .          )*wgt*flux*pswt/BrnRat/dfloat(itmx)
          wt_qqb=(xmsq_bypart(nd,+1,-1)+xmsq_bypart(nd,-1,+1)
     .          )*wgt*flux*pswt/BrnRat/dfloat(itmx)
c        endif
        failed=.false.

        if (nd .eq. 0) then
c---if there's no real contribution, record the event as failing to pass cuts
          if (xmsq(nd) .eq. 0d0) then
             failed=.true.
             goto 996
          endif
        else
c--- if this dipole has no contribution, go to end of loop
          if (xmsq(nd) .eq. 0d0) goto 997
c---check whether each counter-event passes the cuts
          do j=1,mxpart
          do k=1,4
          q(j,k)=ptilde(nd,j,k)
          enddo
          enddo

          if (incldip(nd)) incldip(nd)=includedipole(nd,q)
          if (incldip(nd) .eqv. .false.) failed=.true.
        endif

 996    if (failed) then
          if (nd .eq. 0) then
            ncutzero=ncutzero+1
            ntotzero=ntotzero+1
          endif
          call dotem(nvec,p,s)
          xmsq(nd)=0d0
          goto 997
        endif

c---if it does, add to total
!        xint=xint+xmsq(nd)
c---  SSbegin
        xint=xint+xmsq(nd)*reweight
c---  SSend

        val=wgt*flux*pswt/BrnRat
        do j=-1,1
        do k=-1,1
!$omp atomic
          lord_bypart(j,k)=lord_bypart(j,k)+
     .         val*xmsq_bypart(nd,j,k)
        enddo
        enddo

        val=xmsq(nd)*wgt
        val2=val**2

      valsum=valsum+val

cz Fill bwgt if needed
        if(dabs(msqtmp(nd)).gt.0d0) bwgt=bwgttmp(nd)/msqtmp(nd)
cz //

c--- update PDF errors
        if (PDFerrors) then
          do currentPDF=0,maxPDFsets
          PDFwgt(currentPDF)=
     .       flux*pswt*PDFxsec_nd(currentPDF,nd)/BrnRat*wgt/itmx
          PDFxsec(currentPDF)=PDFxsec(currentPDF)
     .       +PDFwgt(currentPDF)
          enddo
        endif

c---if we're binning, add to histo too
        if (bin) then
          call getptildejet(nd,pjet)
          call dotem(nvec,pjet,s)
          call nplotter(pjet,val,val2,nd)
c--- POWHEG-style output if requested
          if (writepwg) then
            if (nd .eq. 0) then
!$omp critical(pwhgplotter)
              call pwhgplotter(p,pjet,val,nd)
!$omp end critical(pwhgplotter)
            else
             do j=1,mxpart
              do k=1,4
              q(j,k)=ptilde(nd,j,k)
              enddo
              enddo
!$omp critical(pwhgplotter)
              call pwhgplotter(q,pjet,val,nd)
!$omp end critical(pwhgplotter)
            endif
          endif
        endif
c---otherwise, skip contribution
 997    continue
      enddo

c 998  continue

c--- add temporary histograms to cumulative totals
      if (bin) then
         call smartadd(wgt)
      endif
c--- update the maximum weight so far, if necessary
      if (dabs(valsum) .gt. wtmax) then
!$omp critical(MaxWgt)
        wtmax=dabs(valsum)
!$omp end critical(MaxWgt)
      endif

      if (realwt) then
      realint=xmsq(0)
      else
      realint=xint
      endif
      xreal=xreal+xint*wgt/dfloat(itmx)
      xreal2=xreal2+(xint*wgt)**2/dfloat(itmx)

c--- handle special case of Qflag and Gflag
      if (QandGflag) then
        QandGint=QandGint+realint
        if ((Gflag) .and. (.not.(Qflag))) then
c--- go back for second pass (Qflag), calling includedipole first to reset
c--- the values of "jets" and "jetlabel"
          includereal=includedipole(0,p)
          Qflag=.true.
          Gflag=.false.
          goto 44
        else
c--- return both to .true. and assign value to realint (to return to VEGAS)
          Qflag=.true.
          Gflag=.true.
          realint=QandGint
        endif
      endif

      return

 999  realint=0d0
      ntotzero=ntotzero+1
c--- safety catch
      if (QandGflag) then
        Qflag=.true.
        Gflag=.true.
      endif
      return
      end