Ignore:
Timestamp:
May 3, 2019 3:31:22 PM (5 years ago)
Author:
forkel
Message:

fix in def_salsa+simple/chem_gasphase_mod.kpp and finaling def_salsa+phstat

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_salsa+phstat/chem_gasphase_mod.f90

    r3944 r3949  
    117117!
    118118! File                 : chem_gasphase_mod_Parameters.f90
    119 ! Time                 : Thu Mar 28 15:59:27 2019
    120 ! Working directory    : /home/forkel-r/palmstuff/work/trunk20190327/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
     119! Time                 : Fri May  3 17:24:49 2019
     120! Working directory    : /home/forkel-r/palmstuff/work/trunk20190503/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
    121121! Equation file        : chem_gasphase_mod.kpp
    122122! Output root filename : chem_gasphase_mod
     
    130130
    131131! NSPEC - Number of chemical species
    132   INTEGER, PARAMETER :: nspec = 3
     132  INTEGER, PARAMETER :: nspec = 8
    133133! NVAR - Number of Variable species
    134   INTEGER, PARAMETER :: nvar = 3
     134  INTEGER, PARAMETER :: nvar = 8
    135135! NVARACT - Number of Active species
    136   INTEGER, PARAMETER :: nvaract = 3
     136  INTEGER, PARAMETER :: nvaract = 8
    137137! NFIX - Number of Fixed species
    138138  INTEGER, PARAMETER :: nfix = 1
    139139! NREACT - Number of reactions
    140   INTEGER, PARAMETER :: nreact = 2
     140  INTEGER, PARAMETER :: nreact = 7
    141141! NVARST - Starting of variables in conc. vect.
    142142  INTEGER, PARAMETER :: nvarst = 1
    143143! NFIXST - Starting of fixed in conc. vect.
    144   INTEGER, PARAMETER :: nfixst = 4
     144  INTEGER, PARAMETER :: nfixst = 9
    145145! NONZERO - Number of nonzero entries in Jacobian
    146   INTEGER, PARAMETER :: nonzero = 9
     146  INTEGER, PARAMETER :: nonzero = 14
    147147! LU_NONZERO - Number of nonzero entries in LU factoriz. of Jacobian
    148   INTEGER, PARAMETER :: lu_nonzero = 9
     148  INTEGER, PARAMETER :: lu_nonzero = 14
    149149! CNVAR - (NVAR+1) Number of elements in compressed row format
    150   INTEGER, PARAMETER :: cnvar = 4
     150  INTEGER, PARAMETER :: cnvar = 9
    151151! CNEQN - (NREACT+1) Number stoicm elements in compressed col format
    152   INTEGER, PARAMETER :: cneqn = 3
     152  INTEGER, PARAMETER :: cneqn = 8
    153153! NHESS - Length of Sparse Hessian
    154154  INTEGER, PARAMETER :: nhess = 3
     
    159159!   VAR(ind_spc) = C(ind_spc)
    160160
    161   INTEGER, PARAMETER, PUBLIC :: ind_o3 = 1
    162   INTEGER, PARAMETER, PUBLIC :: ind_no = 2
    163   INTEGER, PARAMETER, PUBLIC :: ind_no2 = 3
     161  INTEGER, PARAMETER, PUBLIC :: ind_hno3 = 1
     162  INTEGER, PARAMETER, PUBLIC :: ind_h2so4 = 2
     163  INTEGER, PARAMETER, PUBLIC :: ind_nh3 = 3
     164  INTEGER, PARAMETER, PUBLIC :: ind_ocnv = 4
     165  INTEGER, PARAMETER, PUBLIC :: ind_ocsv = 5
     166  INTEGER, PARAMETER, PUBLIC :: ind_no2 = 6
     167  INTEGER, PARAMETER, PUBLIC :: ind_o3 = 7
     168  INTEGER, PARAMETER, PUBLIC :: ind_no = 8
    164169
    165170! Index declaration for fixed species in C
     
    172177
    173178! NJVRP - Length of sparse Jacobian JVRP
    174   INTEGER, PARAMETER :: njvrp = 3
     179  INTEGER, PARAMETER :: njvrp = 8
    175180
    176181! NSTOICM - Length of Sparse Stoichiometric Matrix
     
    193198!
    194199! File                 : chem_gasphase_mod_Global.f90
    195 ! Time                 : Thu Mar 28 15:59:27 2019
    196 ! Working directory    : /home/forkel-r/palmstuff/work/trunk20190327/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
     200! Time                 : Fri May  3 17:24:49 2019
     201! Working directory    : /home/forkel-r/palmstuff/work/trunk20190503/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
    197202! Equation file        : chem_gasphase_mod.kpp
    198203! Output root filename : chem_gasphase_mod
     
    232237
    233238! QVAP - Water vapor
    234 ! REAL(dp),dimension(:),allocatable             :: qvap
    235   REAL(dp)                                    :: qvap
    236 ! FAKT - Conversion factor
    237 ! REAL(dp),dimension(:),allocatable             :: fakt
    238   REAL(dp)                                    :: fakt
    239 
    240   !   declaration of global variable declarations for photolysis will come from
    241 
    242 ! QVAP - Water vapor
    243239  REAL(kind=dp):: qvap
    244240! FAKT - Conversion factor
     
    267263!
    268264! File                 : chem_gasphase_mod_JacobianSP.f90
    269 ! Time                 : Thu Mar 28 15:59:27 2019
    270 ! Working directory    : /home/forkel-r/palmstuff/work/trunk20190327/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
     265! Time                 : Fri May  3 17:24:49 2019
     266! Working directory    : /home/forkel-r/palmstuff/work/trunk20190503/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
    271267! Equation file        : chem_gasphase_mod.kpp
    272268! Output root filename : chem_gasphase_mod
     
    282278
    283279
    284   INTEGER, PARAMETER, DIMENSION(9):: lu_irow =  (/ &
    285        1, 1, 1, 2, 2, 2, 3, 3, 3 /)
    286 
    287   INTEGER, PARAMETER, DIMENSION(9):: lu_icol =  (/ &
    288        1, 2, 3, 1, 2, 3, 1, 2, 3 /)
    289 
    290   INTEGER, PARAMETER, DIMENSION(4):: lu_crow =  (/ &
    291        1, 4, 7, 10 /)
    292 
    293   INTEGER, PARAMETER, DIMENSION(4):: lu_diag =  (/ &
    294        1, 5, 9, 10 /)
     280  INTEGER, PARAMETER, DIMENSION(14):: lu_irow =  (/ &
     281       1, 2, 3, 4, 5, 6, 6, 6, 7, 7, 7, 8, &
     282       8, 8 /)
     283
     284  INTEGER, PARAMETER, DIMENSION(14):: lu_icol =  (/ &
     285       1, 2, 3, 4, 5, 6, 7, 8, 6, 7, 8, 6, &
     286       7, 8 /)
     287
     288  INTEGER, PARAMETER, DIMENSION(9):: lu_crow =  (/ &
     289       1, 2, 3, 4, 5, 6, 9, 12, 15 /)
     290
     291  INTEGER, PARAMETER, DIMENSION(9):: lu_diag =  (/ &
     292       1, 2, 3, 4, 5, 6, 10, 14, 15 /)
    295293
    296294
     
    311309!
    312310! File                 : chem_gasphase_mod_Monitor.f90
    313 ! Time                 : Thu Mar 28 15:59:27 2019
    314 ! Working directory    : /home/forkel-r/palmstuff/work/trunk20190327/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
     311! Time                 : Fri May  3 17:24:49 2019
     312! Working directory    : /home/forkel-r/palmstuff/work/trunk20190503/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
    315313! Equation file        : chem_gasphase_mod.kpp
    316314! Output root filename : chem_gasphase_mod
     
    322320
    323321
    324   CHARACTER(len=15), PARAMETER, DIMENSION(3):: spc_names =  (/ &
    325      'O3             ','NO             ','NO2            ' /)
    326 
    327   CHARACTER(len=100), PARAMETER, DIMENSION(2):: eqn_names =  (/ &
     322  CHARACTER(len=15), PARAMETER, DIMENSION(8):: spc_names =  (/ &
     323     'HNO3           ','H2SO4          ','NH3            ',&
     324     'OCNV           ','OCSV           ','NO2            ',&
     325     'O3             ','NO             ' /)
     326
     327  CHARACTER(len=100), PARAMETER, DIMENSION(7):: eqn_names =  (/ &
    328328     '    NO2 --> O3 + NO                                                                                 ',&
    329      'O3 + NO --> NO2                                                                                     ' /)
     329     'O3 + NO --> NO2                                                                                     ',&
     330     '  H2SO4 --> H2SO4                                                                                   ',&
     331     '   HNO3 --> HNO3                                                                                    ',&
     332     '    NH3 --> NH3                                                                                     ',&
     333     '   OCNV --> OCNV                                                                                    ',&
     334     '   OCSV --> OCSV                                                                                    ' /)
    330335
    331336! INLINED global variables
     
    371376!
    372377! File                 : chem_gasphase_mod_Initialize.f90
    373 ! Time                 : Thu Mar 28 15:59:27 2019
    374 ! Working directory    : /home/forkel-r/palmstuff/work/trunk20190327/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
     378! Time                 : Fri May  3 17:24:49 2019
     379! Working directory    : /home/forkel-r/palmstuff/work/trunk20190503/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
    375380! Equation file        : chem_gasphase_mod.kpp
    376381! Output root filename : chem_gasphase_mod
     
    397402!
    398403! File                 : chem_gasphase_mod_Integrator.f90
    399 ! Time                 : Thu Mar 28 15:59:27 2019
    400 ! Working directory    : /home/forkel-r/palmstuff/work/trunk20190327/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
     404! Time                 : Fri May  3 17:24:49 2019
     405! Working directory    : /home/forkel-r/palmstuff/work/trunk20190503/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
    401406! Equation file        : chem_gasphase_mod.kpp
    402407! Output root filename : chem_gasphase_mod
     
    455460!
    456461! File                 : chem_gasphase_mod_LinearAlgebra.f90
    457 ! Time                 : Thu Mar 28 15:59:27 2019
    458 ! Working directory    : /home/forkel-r/palmstuff/work/trunk20190327/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
     462! Time                 : Fri May  3 17:24:49 2019
     463! Working directory    : /home/forkel-r/palmstuff/work/trunk20190503/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
    459464! Equation file        : chem_gasphase_mod.kpp
    460465! Output root filename : chem_gasphase_mod
     
    482487!
    483488! File                 : chem_gasphase_mod_Jacobian.f90
    484 ! Time                 : Thu Mar 28 15:59:27 2019
    485 ! Working directory    : /home/forkel-r/palmstuff/work/trunk20190327/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
     489! Time                 : Fri May  3 17:24:49 2019
     490! Working directory    : /home/forkel-r/palmstuff/work/trunk20190503/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
    486491! Equation file        : chem_gasphase_mod.kpp
    487492! Output root filename : chem_gasphase_mod
     
    509514!
    510515! File                 : chem_gasphase_mod_Function.f90
    511 ! Time                 : Thu Mar 28 15:59:27 2019
    512 ! Working directory    : /home/forkel-r/palmstuff/work/trunk20190327/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
     516! Time                 : Fri May  3 17:24:49 2019
     517! Working directory    : /home/forkel-r/palmstuff/work/trunk20190503/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
    513518! Equation file        : chem_gasphase_mod.kpp
    514519! Output root filename : chem_gasphase_mod
     
    538543!
    539544! File                 : chem_gasphase_mod_Rates.f90
    540 ! Time                 : Thu Mar 28 15:59:27 2019
    541 ! Working directory    : /home/forkel-r/palmstuff/work/trunk20190327/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
     545! Time                 : Fri May  3 17:24:49 2019
     546! Working directory    : /home/forkel-r/palmstuff/work/trunk20190503/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
    542547! Equation file        : chem_gasphase_mod.kpp
    543548! Output root filename : chem_gasphase_mod
     
    564569!
    565570! File                 : chem_gasphase_mod_Util.f90
    566 ! Time                 : Thu Mar 28 15:59:27 2019
    567 ! Working directory    : /home/forkel-r/palmstuff/work/trunk20190327/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
     571! Time                 : Fri May  3 17:24:49 2019
     572! Working directory    : /home/forkel-r/palmstuff/work/trunk20190503/UTIL/chemistry/gasphase_preproc/tmp_kpp4palm
    568573! Equation file        : chem_gasphase_mod.kpp
    569574! Output root filename : chem_gasphase_mod
     
    792797
    793798! Computation of equation rates
    794   a(1) = rct(1) * v(3)
    795   a(2) = rct(2) * v(1) * v(2)
     799  a(1) = rct(1) * v(6)
     800  a(2) = rct(2) * v(7) * v(8)
    796801
    797802! Aggregate function
    798   vdot(1) = a(1) - a(2)
    799   vdot(2) = a(1) - a(2)
    800   vdot(3) = - a(1) + a(2)
     803  vdot(1) = 0
     804  vdot(2) = 0
     805  vdot(3) = 0
     806  vdot(4) = 0
     807  vdot(5) = 0
     808  vdot(6) = - a(1) + a(2)
     809  vdot(7) = a(1) - a(2)
     810  vdot(8) = a(1) - a(2)
    801811     
    802812END SUBROUTINE fun
     
    809819  REAL(kind=dp):: x(nvar)
    810820
    811   x(2) = x(2) - jvs(4) * x(1)
    812   x(3) = x(3) - jvs(7) * x(1) - jvs(8) * x(2)
    813   x(3) = x(3) / jvs(9)
    814   x(2) = (x(2) - jvs(6) * x(3)) /(jvs(5))
    815   x(1) = (x(1) - jvs(2) * x(2) - jvs(3) * x(3)) /(jvs(1))
     821  x(7) = x(7) - jvs(9) * x(6)
     822  x(8) = x(8) - jvs(12) * x(6) - jvs(13) * x(7)
     823  x(8) = x(8) / jvs(14)
     824  x(7) = (x(7) - jvs(11) * x(8)) /(jvs(10))
     825  x(6) = (x(6) - jvs(7) * x(7) - jvs(8) * x(8)) /(jvs(6))
     826  x(5) = x(5) / jvs(5)
     827  x(4) = x(4) / jvs(4)
     828  x(3) = x(3) / jvs(3)
     829  x(2) = x(2) / jvs(2)
     830  x(1) = x(1) / jvs(1)
    816831     
    817832END SUBROUTINE kppsolve
     
    831846! Local variables
    832847! B - Temporary array
    833   REAL(kind=dp):: b(3)
     848  REAL(kind=dp):: b(8)
    834849!
    835850! Following line is just to avoid compiler message about unused variables
    836851   IF ( f(nfix) > 0.0_dp )  CONTINUE
    837852
    838 ! B(1) = dA(1)/dV(3)
     853! B(1) = dA(1)/dV(6)
    839854  b(1) = rct(1)
    840 ! B(2) = dA(2)/dV(1)
    841   b(2) = rct(2) * v(2)
    842 ! B(3) = dA(2)/dV(2)
    843   b(3) = rct(2) * v(1)
     855! B(2) = dA(2)/dV(7)
     856  b(2) = rct(2) * v(8)
     857! B(3) = dA(2)/dV(8)
     858  b(3) = rct(2) * v(7)
     859! B(4) = dA(3)/dV(2)
     860  b(4) = rct(3)
     861! B(5) = dA(4)/dV(1)
     862  b(5) = rct(4)
     863! B(6) = dA(5)/dV(3)
     864  b(6) = rct(5)
     865! B(7) = dA(6)/dV(4)
     866  b(7) = rct(6)
     867! B(8) = dA(7)/dV(5)
     868  b(8) = rct(7)
    844869
    845870! Construct the Jacobian terms from B's
    846871! JVS(1) = Jac_FULL(1,1)
    847   jvs(1) = - b(2)
    848 ! JVS(2) = Jac_FULL(1,2)
    849   jvs(2) = - b(3)
    850 ! JVS(3) = Jac_FULL(1,3)
    851   jvs(3) = b(1)
    852 ! JVS(4) = Jac_FULL(2,1)
    853   jvs(4) = - b(2)
    854 ! JVS(5) = Jac_FULL(2,2)
    855   jvs(5) = - b(3)
    856 ! JVS(6) = Jac_FULL(2,3)
    857   jvs(6) = b(1)
    858 ! JVS(7) = Jac_FULL(3,1)
     872  jvs(1) = 0
     873! JVS(2) = Jac_FULL(2,2)
     874  jvs(2) = 0
     875! JVS(3) = Jac_FULL(3,3)
     876  jvs(3) = 0
     877! JVS(4) = Jac_FULL(4,4)
     878  jvs(4) = 0
     879! JVS(5) = Jac_FULL(5,5)
     880  jvs(5) = 0
     881! JVS(6) = Jac_FULL(6,6)
     882  jvs(6) = - b(1)
     883! JVS(7) = Jac_FULL(6,7)
    859884  jvs(7) = b(2)
    860 ! JVS(8) = Jac_FULL(3,2)
     885! JVS(8) = Jac_FULL(6,8)
    861886  jvs(8) = b(3)
    862 ! JVS(9) = Jac_FULL(3,3)
    863   jvs(9) = - b(1)
     887! JVS(9) = Jac_FULL(7,6)
     888  jvs(9) = b(1)
     889! JVS(10) = Jac_FULL(7,7)
     890  jvs(10) = - b(2)
     891! JVS(11) = Jac_FULL(7,8)
     892  jvs(11) = - b(3)
     893! JVS(12) = Jac_FULL(8,6)
     894  jvs(12) = b(1)
     895! JVS(13) = Jac_FULL(8,7)
     896  jvs(13) = - b(2)
     897! JVS(14) = Jac_FULL(8,8)
     898  jvs(14) = - b(3)
    864899     
    865900END SUBROUTINE jac_sp
     
    890925  rconst(1) = (phot(j_no2))
    891926  rconst(2) = (arr2(1.8e-12_dp , 1370.0_dp , temp))
     927  rconst(3) = (1.0_dp)
     928  rconst(4) = (1.0_dp)
     929  rconst(5) = (1.0_dp)
     930  rconst(6) = (1.0_dp)
     931  rconst(7) = (1.0_dp)
    892932     
    893933END SUBROUTINE update_rconst
     
    22822322!   i = 1
    22832323!   i = 2
    2284     jvs(4) = (jvs(4)) / jvs(1)
    2285     jvs(5) = jvs(5) - jvs(2) * jvs(4)
    2286     jvs(6) = jvs(6) - jvs(3) * jvs(4)
    22872324!   i = 3
    2288     jvs(7) = (jvs(7)) / jvs(1)
    2289     a = 0.0; a = a  - jvs(2) * jvs(7)
    2290     jvs(8) = (jvs(8) + a) / jvs(5)
    2291     jvs(9) = jvs(9) - jvs(3) * jvs(7) - jvs(6) * jvs(8)
     2325!   i = 4
     2326!   i = 5
     2327!   i = 6
     2328!   i = 7
     2329    jvs(9) = (jvs(9)) / jvs(6)
     2330    jvs(10) = jvs(10) - jvs(7) * jvs(9)
     2331    jvs(11) = jvs(11) - jvs(8) * jvs(9)
     2332!   i = 8
     2333    jvs(12) = (jvs(12)) / jvs(6)
     2334    a = 0.0; a = a  - jvs(7) * jvs(12)
     2335    jvs(13) = (jvs(13) + a) / jvs(10)
     2336    jvs(14) = jvs(14) - jvs(8) * jvs(12) - jvs(11) * jvs(13)
    22922337    RETURN                                                           
    22932338                                                                     
Note: See TracChangeset for help on using the changeset viewer.