diff --git a/.gitignore b/.gitignore index c6127b3..87e58ca 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,6 @@ +# Backup files +*~ + # Prerequisites *.d @@ -50,3 +53,28 @@ modules.order Module.symvers Mkfile.old dkms.conf + +# LaTeX - used in docs +*.aux +*.glo +*.idx +*.log +*.toc +*.ist +*.acn +*.acr +*.alg +*.bbl +*.blg +*.dvi +*.glg +*.gls +*.ilg +*.ind +*.lof +*.lot +*.maf +*.mtc +*.mtc1 +*.out +*.synctex.gz \ No newline at end of file diff --git a/DPHF/arrh.c b/DPHF/arrh.c new file mode 100644 index 0000000..7c865fc --- /dev/null +++ b/DPHF/arrh.c @@ -0,0 +1,7 @@ +#include +void arrh(r,a,e,T) +double *r; +double a,e,T; +{ *r= a*exp(-e/T); +} + diff --git a/DPHF/burst.des b/DPHF/burst.des new file mode 100644 index 0000000..5123947 --- /dev/null +++ b/DPHF/burst.des @@ -0,0 +1,64 @@ +/* Belousov - Zhabotinsky reaction, Burst generation */ +/* k = 2.9; g = 0.42; kf6 = k*g; kf7 = k * ( 1 - g ) ; */ +/* Reduceret model, KN 27.9 1994 */ + +dtime = 10.00; +etime = 20000.0; +htime = 0.005; +epsr = 1.0E-4; +epsa = 1.0E-20; + + +prnmode = 0; +method = 4; +stepadjust = 0.9; +maxinc = 1.5; +mindec = 0.5; +htimemin = 1.0E-20; +datafile = "burstdat1"; +ref=3; +hopfbftp=1.0; + +/* Parameters */ +/* +j0 = 8.500000L-05; +kf6= 8.2; +*/ +C0 = 0.86L-4; + +#parameter j0 = 0.85E-04, 0.0, 1.0, 1.0E-8, 0.000001, 1.0; +#parameter kf6 = 8.2, 0.0, 100.0, 1.0E-2, 0.0001, -1.0; + +/* Flow terms */ +101: HBrO2 -> P ; k> = j0; +102: Br(-) -> P ; k> = j0; +103: CeIV -> P ; k> = j0; +104: HBrO -> P ; k> = j0; +105: BrO2 -> P ; k> = j0; +106: BrMA -> P ; k> = j0; + + +1: BrO3(-) + Br(-) + 2H(+) -> HBrO2 + HBrO ; k> = 2.0; +2: HBrO2 + Br(-) + H(+) -> 2HBrO ; k> = 2.0L6; +3: BrO3(-) + HBrO2 + H(+) <=> 2BrO2 + H2O ; k> = 33.0; k< = 7.0L5; +4: BrO2 + CeIII + H(+) <=> HBrO2 + CeIV ; k> = 6.2L4;k< = 7.0L3; +5: 2HBrO2 -> HBrO + BrO3(-) + H(+) ; k> = 3.0L3; +6: HBrO + MA -> BrMA + H2O ; k> = kf6; +7: CeIV + MA -> CeIII + P ; k> = 0.3; +8: CeIV + BrMA -> Br(-) + CeIII ; k> = 30.0; + +[BrO3(-)] = 0.012; +[MA] = 0.167; +[H(+)] = 1.0; +[H2O] = 55.5; +[P] = 0.0; + +[CeIII] = C0 - [CeIV]; + + +[HBrO2](0) = 4.153821e-08; +[Br(-)](0) = 3.217686e-07; +[CeIV](0) = 7.906439e-07; +[HBrO](0) = 2.281131e-08; +[BrO2](0) = 5.854012e-09; +[BrMA](0) = 1.696279e-03; diff --git a/DPHF/burstdat1 b/DPHF/burstdat1 new file mode 100644 index 0000000..3a69951 --- /dev/null +++ b/DPHF/burstdat1 @@ -0,0 +1,410 @@ +Point no: 1 + +Fst. parameter: 9.0402996101504L-05 +Snd. parameter: 8.1999998092651L+00 + +HBrO2 : 7.7180627822662L-07 +Br_m : 9.8391825896951L-08 +CeIV : 3.0252764849626L-06 +HBrO : 2.2444698537458L-07 +BrO2 : 6.2637297488954L-08 +BrMA : 1.6972203270047L-03 + +Ref: 3 Omega: 3.4079745455956L-02 +d_alfa: -4.3917154430608L+02 d_omega: 8.0459348062470L-01 + +************************ Hassard ************************* +c1.re: -8.5295802703083L+08 c1.im: -1.5799134042146L+09 +my2: -1.9421978452146L+06 beta2: -1.7059160540617L+09 +tau2: 4.6405161270433L+10 + +************************ Eigenvalues ************************ + Re Im + 4.5506209911395L-11 -3.4079745455956L-02 + 4.5506209911395L-11 3.4079745455956L-02 + -4.9324230594460L-04 0.0000000000000L+00 + -1.3702677032202L+00 0.0000000000000L+00 + -1.7465810398370L+00 0.0000000000000L+00 + -1.5432097594265L+01 0.0000000000000L+00 + +*********************** Quenching Data *********************** + Reconstruction Stopdata + Amount Phase Amount Phase +HBrO2 4.324L-01 -17.72 1.515L-01 90.82 +Br_m 2.540L-02 140.43 1.563L-01 -90.59 +CeIV 1.000L+00 0.00 3.253L-01 -108.06 +HBrO 7.528L-02 0.28 1.047L+02 -166.81 +BrO2 2.423L-02 -17.14 2.897L-01 96.41 +BrMA 1.531L+00 90.25 1.047L+02 -165.38 + -1.481L-01 23.85 + +************************************************************** +Point no: 2 + +Fst. parameter: 9.0398904227755L-05 +Snd. parameter: 8.1899998094887L+00 + +HBrO2 : 7.7187198291588L-07 +Br_m : 9.8402571787487L-08 +CeIV : 3.0251113236070L-06 +HBrO : 2.2470317273125L-07 +BrO2 : 6.2635222775346L-08 +BrMA : 1.6972714088586L-03 + +Ref: 3 Omega: 3.4083973699683L-02 +d_alfa: -4.3849905127416L+02 d_omega: -5.1738470789534L-01 + +************************ Hassard ************************* +c1.re: -8.5263708410117L+08 c1.im: -1.5799360011139L+09 +my2: -1.9444445355666L+06 beta2: -1.7052741682023L+09 +tau2: 4.6324703485515L+10 + +************************ Eigenvalues ************************ + Re Im + -3.1259932142813L-11 -3.4083973699683L-02 + -3.1259932142813L-11 3.4083973699683L-02 + -4.9312539538223L-04 0.0000000000000L+00 + -1.3685940119000L+00 0.0000000000000L+00 + -1.7467356704473L+00 0.0000000000000L+00 + -1.5431788969058L+01 0.0000000000000L+00 + +*********************** Quenching Data *********************** + Reconstruction Stopdata + Amount Phase Amount Phase +HBrO2 4.324L-01 -17.72 1.516L-01 90.82 +Br_m 2.540L-02 140.43 1.563L-01 -90.59 +CeIV 1.000L+00 0.00 3.254L-01 -108.06 +HBrO 7.538L-02 0.28 1.047L+02 -166.81 +BrO2 2.423L-02 -17.14 2.897L-01 96.41 +BrMA 1.531L+00 90.26 1.047L+02 -165.38 + -1.482L-01 23.85 + +************************************************************** +Point no: 3 + +Fst. parameter: 9.0411899233997L-05 +Snd. parameter: 8.1799998097122L+00 + +HBrO2 : 7.7168785340935L-07 +Br_m : 9.8369368912765L-08 +CeIV : 3.0256247614946L-06 +HBrO : 2.2503107884333L-07 +BrO2 : 6.2641827326494L-08 +BrMA : 1.6971017763964L-03 + +Ref: 3 Omega: 3.4070535282619L-02 +d_alfa: -4.4393058798230L+02 d_omega: 1.2252158778205L+01 + +************************ Hassard ************************* +c1.re: -8.5363073142330L+08 c1.im: -1.5799173024327L+09 +my2: -1.9228923496872L+06 beta2: -1.7072614628466L+09 +tau2: 4.7063448563792L+10 + +************************ Eigenvalues ************************ + Re Im + 1.4880208176749L-11 -3.4070535282619L-02 + 1.4880208176749L-11 3.4070535282619L-02 + -4.9349604124471L-04 0.0000000000000L+00 + -1.3669214694989L+00 0.0000000000000L+00 + -1.7463098425630L+00 0.0000000000000L+00 + -1.5432772327693L+01 0.0000000000000L+00 + +*********************** Quenching Data *********************** + Reconstruction Stopdata + Amount Phase Amount Phase +HBrO2 4.324L-01 -17.71 1.515L-01 90.82 +Br_m 2.539L-02 140.43 1.562L-01 -90.59 +CeIV 1.000L+00 0.00 3.253L-01 -108.05 +HBrO 7.546L-02 0.29 1.046L+02 -166.81 +BrO2 2.423L-02 -17.13 2.897L-01 96.41 +BrMA 1.531L+00 90.26 1.046L+02 -165.38 + -1.481L-01 23.85 + +************************************************************** +Point no: 4 + +Fst. parameter: 9.0400000162156L-05 +Snd. parameter: 8.1699998099357L+00 + +HBrO2 : 7.7184852065467L-07 +Br_m : 9.8399409971760L-08 +CeIV : 3.0251596651669L-06 +HBrO : 2.2525892542111L-07 +BrO2 : 6.2635797266056L-08 +BrMA : 1.6972593658518L-03 + +Ref: 3 Omega: 3.4082786066883L-02 +d_alfa: -4.3822024312897L+02 d_omega: -1.2101798197696L+00 + +************************ Hassard ************************* +c1.re: -8.5273025742979L+08 c1.im: -1.5799141884414L+09 +my2: -1.9458942639006L+06 beta2: -1.7054605148596L+09 +tau2: 4.6286101827946L+10 + +************************ Eigenvalues ************************ + Re Im + 4.6320447477655L-11 -3.4082786066883L-02 + 4.6320447477655L-11 3.4082786066883L-02 + -4.9315814796737L-04 0.0000000000000L+00 + -1.3652473977003L+00 0.0000000000000L+00 + -1.7466895860525L+00 0.0000000000000L+00 + -1.5431874240703L+01 0.0000000000000L+00 + +*********************** Quenching Data *********************** + Reconstruction Stopdata + Amount Phase Amount Phase +HBrO2 4.324L-01 -17.72 1.516L-01 90.82 +Br_m 2.540L-02 140.43 1.563L-01 -90.59 +CeIV 1.000L+00 0.00 3.253L-01 -108.06 +HBrO 7.556L-02 0.29 1.047L+02 -166.81 +BrO2 2.423L-02 -17.14 2.897L-01 96.41 +BrMA 1.531L+00 90.26 1.047L+02 -165.38 + -1.482L-01 23.85 + +************************************************************** +Point no: 5 + +Fst. parameter: 9.0410264348519L-05 +Snd. parameter: 8.1599998101592L+00 + +HBrO2 : 7.7171897992290L-07 +Br_m : 9.8373817272980L-08 +CeIV : 3.0255571865857L-06 +HBrO : 2.2557481332982L-07 +BrO2 : 6.2641013673192L-08 +BrMA : 1.6971203678900L-03 + +Ref: 3 Omega: 3.4072192719500L-02 +d_alfa: -4.4367958866969L+02 d_omega: 1.1624897977906L+01 + +************************ Hassard ************************* +c1.re: -8.5349860677472L+08 c1.im: -1.5799360727402L+09 +my2: -1.9236823792905L+06 beta2: -1.7069972135494L+09 +tau2: 4.7026579631441L+10 + +************************ Eigenvalues ************************ + Re Im + -7.1783745614340L-11 -3.4072192719500L-02 + -7.1783745614340L-11 3.4072192719500L-02 + -4.9344982005969L-04 0.0000000000000L+00 + -1.3635746754349L+00 0.0000000000000L+00 + -1.7463870275971L+00 0.0000000000000L+00 + -1.5432651494441L+01 0.0000000000000L+00 + +*********************** Quenching Data *********************** + Reconstruction Stopdata + Amount Phase Amount Phase +HBrO2 4.324L-01 -17.71 1.515L-01 90.82 +Br_m 2.540L-02 140.43 1.562L-01 -90.59 +CeIV 1.000L+00 0.00 3.253L-01 -108.05 +HBrO 7.565L-02 0.29 1.047L+02 -166.81 +BrO2 2.423L-02 -17.13 2.897L-01 96.41 +BrMA 1.531L+00 90.27 1.046L+02 -165.38 + -1.481L-01 23.85 + +************************************************************** +Point no: 6 + +Fst. parameter: 9.0401252045449L-05 +Snd. parameter: 8.1499998103827L+00 + +HBrO2 : 7.7182269521119L-07 +Br_m : 9.8395843833999L-08 +CeIV : 3.0252142492633L-06 +HBrO : 2.2581806973044L-07 +BrO2 : 6.2636451116196L-08 +BrMA : 1.6972453409592L-03 + +Ref: 3 Omega: 3.4081437245364L-02 +d_alfa: -4.3793764297411L+02 d_omega: -1.9051898183197L+00 + +************************ Hassard ************************* +c1.re: -8.5283551291918L+08 c1.im: -1.5798917710551L+09 +my2: -1.9473902885521L+06 beta2: -1.7056710258384L+09 +tau2: 4.6247510383954L+10 + +************************ Eigenvalues ************************ + Re Im + -3.9511741101173L-11 -3.4081437245364L-02 + -3.9511741101173L-11 3.4081437245364L-02 + -4.9319535376168L-04 0.0000000000000L+00 + -1.3619009072120L+00 0.0000000000000L+00 + -1.7466379183066L+00 0.0000000000000L+00 + -1.5431971323002L+01 0.0000000000000L+00 + +*********************** Quenching Data *********************** + Reconstruction Stopdata + Amount Phase Amount Phase +HBrO2 4.324L-01 -17.72 1.515L-01 90.82 +Br_m 2.540L-02 140.43 1.563L-01 -90.59 +CeIV 1.000L+00 0.00 3.253L-01 -108.06 +HBrO 7.575L-02 0.29 1.047L+02 -166.81 +BrO2 2.423L-02 -17.14 2.897L-01 96.41 +BrMA 1.531L+00 90.27 1.047L+02 -165.38 + -1.482L-01 23.85 + +************************************************************** +Point no: 7 + +Fst. parameter: 9.0408755288606L-05 +Snd. parameter: 8.1399998106062L+00 + +HBrO2 : 7.7174697909130L-07 +Br_m : 9.8377889254644L-08 +CeIV : 3.0254952796696L-06 +HBrO : 2.2612193415576L-07 +BrO2 : 6.2640264356682L-08 +BrMA : 1.6971377177147L-03 + +Ref: 3 Omega: 3.4073716635186L-02 +d_alfa: -4.4342620355402L+02 d_omega: 1.0994796370655L+01 + +************************ Hassard ************************* +c1.re: -8.5337757643106L+08 c1.im: -1.5799515932989L+09 +my2: -1.9245086771853L+06 beta2: -1.7067551528621L+09 +tau2: 4.6989625213492L+10 + +************************ Eigenvalues ************************ + Re Im + 7.9562353233475L-11 -3.4073716635186L-02 + 7.9562353233475L-11 3.4073716635186L-02 + -4.9340732501072L-04 0.0000000000000L+00 + -1.3602280139382L+00 0.0000000000000L+00 + -1.7464571327500L+00 0.0000000000000L+00 + -1.5432540192248L+01 0.0000000000000L+00 + +*********************** Quenching Data *********************** + Reconstruction Stopdata + Amount Phase Amount Phase +HBrO2 4.324L-01 -17.71 1.515L-01 90.82 +Br_m 2.540L-02 140.43 1.563L-01 -90.59 +CeIV 1.000L+00 0.00 3.253L-01 -108.05 +HBrO 7.583L-02 0.29 1.047L+02 -166.82 +BrO2 2.423L-02 -17.13 2.897L-01 96.41 +BrMA 1.531L+00 90.27 1.046L+02 -165.38 + -1.481L-01 23.85 + +************************************************************** +Point no: 8 + +Fst. parameter: 9.0402660593788L-05 +Snd. parameter: 8.1299998108298L+00 + +HBrO2 : 7.7179453467677L-07 +Br_m : 9.8391872383050L-08 +CeIV : 3.0252750819423L-06 +HBrO : 2.2638062722186L-07 +BrO2 : 6.2637184600205L-08 +BrMA : 1.6972292978486L-03 + +Ref: 3 Omega: 3.4079925708564L-02 +d_alfa: -4.3765129977383L+02 d_omega: -2.6024224281020L+00 + +************************ Hassard ************************* +c1.re: -8.5295289157535L+08 c1.im: -1.5798688957131L+09 +my2: -1.9489326137410L+06 beta2: -1.7059057831507L+09 +tau2: 4.6208931417139L+10 + +************************ Eigenvalues ************************ + Re Im + 4.0193480488337L-11 -3.4079925708564L-02 + 4.0193480488337L-11 3.4079925708564L-02 + -4.9323705239138L-04 0.0000000000000L+00 + -1.3585545369374L+00 0.0000000000000L+00 + -1.7465807253780L+00 0.0000000000000L+00 + -1.5432080257882L+01 0.0000000000000L+00 + +*********************** Quenching Data *********************** + Reconstruction Stopdata + Amount Phase Amount Phase +HBrO2 4.324L-01 -17.72 1.515L-01 90.82 +Br_m 2.540L-02 140.43 1.563L-01 -90.59 +CeIV 1.000L+00 0.00 3.253L-01 -108.06 +HBrO 7.593L-02 0.29 1.047L+02 -166.82 +BrO2 2.423L-02 -17.14 2.897L-01 96.41 +BrMA 1.531L+00 90.28 1.047L+02 -165.38 + -1.481L-01 23.85 + +************************************************************** +Point no: 9 + +Fst. parameter: 9.0407374457830L-05 +Snd. parameter: 8.1199998110533L+00 + +HBrO2 : 7.7177190136572L-07 +Br_m : 9.8381582965620L-08 +CeIV : 3.0254390949610L-06 +HBrO : 2.2667246486490L-07 +BrO2 : 6.2639580670732L-08 +BrMA : 1.6971537862442L-03 + +Ref: 3 Omega: 3.4075105710803L-02 +d_alfa: -4.4317043873451L+02 d_omega: 1.0361838482206L+01 + +************************ Hassard ************************* +c1.re: -8.5326770339228L+08 c1.im: -1.5799639875790L+09 +my2: -1.9253714345858L+06 beta2: -1.7065354067846L+09 +tau2: 4.6952587292934L+10 + +************************ Eigenvalues ************************ + Re Im + 8.1727846712454L-11 -3.4075105710803L-02 + 8.1727846712454L-11 3.4075105710803L-02 + -4.9336859200309L-04 0.0000000000000L+00 + -1.3568814810446L+00 0.0000000000000L+00 + -1.7465202602077L+00 0.0000000000000L+00 + -1.5432438617134L+01 0.0000000000000L+00 + +*********************** Quenching Data *********************** + Reconstruction Stopdata + Amount Phase Amount Phase +HBrO2 4.324L-01 -17.71 1.515L-01 90.82 +Br_m 2.540L-02 140.43 1.563L-01 -90.59 +CeIV 1.000L+00 0.00 3.253L-01 -108.05 +HBrO 7.602L-02 0.30 1.047L+02 -166.82 +BrO2 2.423L-02 -17.13 2.897L-01 96.41 +BrMA 1.531L+00 90.28 1.046L+02 -165.38 + -1.481L-01 23.85 + +************************************************************** +Point no: 10 + +Fst. parameter: 9.0404227886099L-05 +Snd. parameter: 8.1099998112768L+00 + +HBrO2 : 7.7176408313660L-07 +Br_m : 9.8387493693647L-08 +CeIV : 3.0253422131386L-06 +HBrO : 2.2694662247678L-07 +BrO2 : 6.2637998916937L-08 +BrMA : 1.6972111953170L-03 + +Ref: 3 Omega: 3.4078249915385L-02 +d_alfa: -4.3734533682998L+02 d_omega: -3.2929915827874L+00 + +************************ Hassard ************************* +c1.re: -8.5308247123399L+08 c1.im: -1.5798456856467L+09 +my2: -1.9505923566429L+06 beta2: -1.7061649424680L+09 +tau2: 4.6170868672587L+10 + +************************ Eigenvalues ************************ + Re Im + 1.7215485981215L-11 -3.4078249915385L-02 + 1.7215485981215L-11 3.4078249915385L-02 + -4.9328328758205L-04 0.0000000000000L+00 + -1.3552082834791L+00 0.0000000000000L+00 + -1.7465180959988L+00 0.0000000000000L+00 + -1.5432201226994L+01 0.0000000000000L+00 + +*********************** Quenching Data *********************** + Reconstruction Stopdata + Amount Phase Amount Phase +HBrO2 4.324L-01 -17.72 1.515L-01 90.82 +Br_m 2.540L-02 140.43 1.563L-01 -90.59 +CeIV 1.000L+00 0.00 3.253L-01 -108.05 +HBrO 7.612L-02 0.30 1.047L+02 -166.82 +BrO2 2.423L-02 -17.14 2.897L-01 96.41 +BrMA 1.531L+00 90.28 1.047L+02 -165.38 + -1.481L-01 23.85 + +************************************************************** diff --git a/DPHF/burstdat1.t b/DPHF/burstdat1.t new file mode 100644 index 0000000..c55fb05 --- /dev/null +++ b/DPHF/burstdat1.t @@ -0,0 +1,18 @@ +/* Dimension : 6*/ +/* No of datapoints : 10 */ +/* Dimension : 6*/ +/* No of datapoints : 1 */ +/* Dimension : 6*/ +/* No of datapoints : 1 */ +/* Dimension : 6*/ +/* No of datapoints : 1 */ +/* Dimension : 6*/ +/* No of datapoints : 1 */ +/* Dimension : 6*/ +/* No of datapoints : 1 */ +/* Dimension : 6*/ +/* No of datapoints : 1 */ +/* Dimension : 6*/ +/* No of datapoints : 10 */ +/* Dimension : 6*/ +/* No of datapoints : 10 */ diff --git a/DPHF/complex.proc b/DPHF/complex.proc new file mode 100644 index 0000000..87af2dc --- /dev/null +++ b/DPHF/complex.proc @@ -0,0 +1,41 @@ +PROCEDURE Complex(a,b: LONGREAL; VAR c: fcomplex); + BEGIN + c.re:= a; c.im:= b; + END; (* Complex *) + +PROCEDURE Cnorm(a: fcomplex; VAR norm: LONGREAL); + BEGIN + norm:= a.re*a.re + a.im*a.im; + END; (* Cnorm *) + +PROCEDURE Cmul(a,b: fcomplex; VAR c: fcomplex); + (* c = a*b *) + BEGIN + c.re:= a.re*b.re - a.im*b.im; + c.im:= a.re*b.im + a.im*b.re; + END; (* Cmul *) + +PROCEDURE Cadd(a,b: fcomplex; VAR c: fcomplex); + (* c = a+b *) + BEGIN + c.re:= a.re+b.re; c.im:= a.im+b.im; + END; (* Cadd *) + + +PROCEDURE RCmul(a: fcomplex; x: LONGREAL; VAR c: fcomplex); + (* c = x*a *) + BEGIN + c.re:= x*a.re; c.im:= x*a.im; + END; (* RCmul *) + +PROCEDURE Cdiv(a,b: fcomplex; VAR c: fcomplex); + (* c = a/b *) + (* procedure Cnorm is used *) + VAR + norm: LONGREAL; + + BEGIN + Cnorm(b,norm); + c.re:= (a.re*b.re + a.im*b.im)/norm; + c.im:= (a.im*b.re - a.re*b.im)/norm; + END; (* Cdiv *) diff --git a/DPHF/dphf.def b/DPHF/dphf.def new file mode 100644 index 0000000..7512bc9 --- /dev/null +++ b/DPHF/dphf.def @@ -0,0 +1,55 @@ +(* New HP435 Pascal Version of Derpar and Hopf continuation + program. Version containing both the derpar-algorithm + and the Hopf-bifurcation calculation. Version 25/10 1994 *) + + CONST + sigint = 2; + n1 = n+1; n2 = n+2; + + TYPE + glnarray = ARRAY [1..n2] OF LONGREAL; + glnpbynp = ARRAY [1..n2,1..n2] OF LONGREAL; + glindx = ARRAY [1..n2] OF INTEGER; + glbln = ARRAY [0..n2] OF BOOLEAN; + strg250 = STRING[250]; + gldjacobian = ARRAY [1..n2,1..n2,1..n2] of LONGREAL; + glddjacobian = ARRAY [1..n2,1..n2,1..n2,1..n2] of LONGREAL; + fcomplex = RECORD + re,im: LONGREAL; + END; + + VAR + beta2,c0kuramoto,c1kuramoto,c2kuramoto,clck, + date,d_alfa,d_dbprime,d_omega,d_prime,dt, + epsa,epsblk,epsbisecr,epsdigit,epsfx,epshqr2,epsmach,epsr, + fid,g_dbprime,g_prime,h,hb,hh,im1,im2,my2, + noofpoints,omega,paraold, + qd,re1,re2,t,tau2,tb,te: LONGREAL; + + corrhreg,cfout,hopfbftp,i,j,kar,maxout,oaddr, + maxitbisec,maxitcorrec,maxithqr2,maxitintpol, + maxititera,maxnoofp,maxoutn1,maxoutn2, + numparam,ps,ref,rr,sigmax,sigmin, + print_on_file,df_calc,eigvec_prn,hass_calc,hf_calc, + kura_calc,print_on_screen,failure_print,para_regu,qc_calc: INTEGER; + + NeedDDJac,notback,need_dd_jac,prog_stop: BOOLEAN; + + datafile,textfile: TEXT; + + adjeigvec,der,eigval,eigvec,inverseigvec,jacobi: glnpbynp; + + ampvec,dif,fivec,fxzero,inithmax,initndir,initpref,initxlow,initxupp, + phasevec,qvec,xmax,xmin,xx: glnarray; + + + name_datafile,name_textfile: strg250; + + nsg,osg: glindx; + + prntindx: glbln; + + derivsjacobian:gldjacobian; + derivsdjacobian:glddjacobian; + + c1: fcomplex; diff --git a/DPHF/dphf.proc b/DPHF/dphf.proc new file mode 100644 index 0000000..36fbd3e --- /dev/null +++ b/DPHF/dphf.proc @@ -0,0 +1,1009 @@ +(* New HP435 Pascal Version of Derpar and Hopf continuation + program. Version containing both the derpar-algorithm + and the Hopf-bifurcation calculation. Version 25/10 1994 *) + + PROCEDURE init; EXTERNAL C; + + FUNCTION signal(SignalNum: INTEGER; ProcAddress: INTEGER): INTEGER; EXTERNAL; + + PROCEDURE inthandler(SignalNum: INTEGER); + BEGIN + WRITELN('Inthandler ',prog_stop); + prog_stop:= TRUE; + WRITELN('Inthandler ',prog_stop); + oaddr:= signal(sigint, Baddress(inthandler)); + END; (* inthandler *) + +PROCEDURE disp(n:INTEGER; t,h,q: LONGREAL; x,xmax,xmin: glnarray);EXTERNAL C; + + +PROCEDURE close_datafile(mode: INTEGER); + + BEGIN + IF mode=0 THEN BEGIN + CLOSE(datafile); + APPEND(textfile,name_textfile); + WRITELN(textfile,'/* Dimension : ',n:4,'*/'); + WRITELN(textfile,'/* No of datapoints : ',noofpoints:10:0,' */'); + CLOSE(textfile); END + ELSE BEGIN END; + END; (* close_datafile *) + +PROCEDURE alarm(level: INTEGER; failure_strg: strg250); + (* level: 0=program exit, 1=warning *) + + BEGIN + WRITELN(failure_strg); + IF level=0 THEN BEGIN + IF (print_on_file=1) THEN BEGIN + WRITELN(name_datafile); close_datafile(0); + END ELSE close_datafile(1); + HALT; END; + END; (* alarm *) + + + PROCEDURE fctn(bj_,tp_: BOOLEAN; xx_: glnarray; + VAR fv_:glnarray; VAR gg_:glnpbynp); + + BEGIN + gg_:= jacobi; fv_:= fxzero; + IF (numparam=1) THEN sp_dalfa(bj_,xx_,gg_) + ELSE hf_dalfa(bj_,tp_,xx_,gg_); + derivs(bj_,xx_,t,fv_,gg_); + END; (* fctn *) + +$include 'complex.proc'$ +$include 'heigvqr.proc'$ +$include 'lu.proc'$ +$include 'gause.proc'$ +$include 'quenchcal.proc'$ +$include 'dphfcalc.proc'$ + +PROCEDURE parainit(level: INTEGER); + VAR + i,j,k,l,nofarg: INTEGER; + + BEGIN + CASE level OF + 1: BEGIN + print_on_screen:= 1; print_on_file:= 1; + failure_print:= 0; para_regu:= 1; + qc_calc:= 0; hf_calc:= 1; + df_calc:= 0; hass_calc:= 1; + kura_calc:= 0; + eigvec_prn:= 0; + name_datafile:= 'kinwrk.dat'; + name_textfile:= 'kinwrk.dat.t'; + t:=0; kar:=1; + FOR i:=1 TO n2 DO BEGIN + fxzero[i]:= 0.0; dif[i]:= 0.0; + FOR j:=1 TO n2 DO jacobi[i,j]:=0.0; END; + FOR i:=1 TO 4 DO + FOR j:=1 TO n2 DO der[i,j]:= 0.0; + FOR i:=1 TO n DO FOR j:=1 TO n DO + FOR k:=1 TO n DO derivsjacobian[i,j,k]:= 0.0; + FOR i:=1 TO n DO FOR j:=1 TO n DO + FOR k:=1 TO n DO FOR l:=1 TO n DO derivsdjacobian[i,j,k,l]:= 0.0; + maxoutn1:= 30; maxoutn2:= 2; + cfout:= 10; + ref:=1; hopfbftp:= -1; ps:= -1; rr:= 1; + re1:= 0.5; im1:= 0.5; + maxnoofp:= 10; maxithqr2:= 30; maxitbisec:= 30; + maxitintpol:= 30; maxititera:= 30; maxitcorrec:= 30; + corrhreg:= 10; hh:= 1.0; epsfx:=1.0E-15; epsblk:=1E-15; + epshqr2:= 1E-20; epsbisecr:= 1E-10; epsmach:= 1E-15; + epsdigit:= 1E-14; + FOR i:=1 TO n2 DO BEGIN + xx[i]:= 0.0; initxlow[i]:= 0.0; initxupp[i]:= 1.0L6; + inithmax[i]:= 1.0; initpref[i]:= 1.0; initndir[i]:= 1.0; END; + paraold:= xx[n2]; + END; (* level=1 *) + 2: BEGIN + nofarg:= ARGC-1; i:= 1; + WHILE i<=nofarg DO + BEGIN + IF (ARGN(i)='-fp') OR (ARGN(i)='-FP') + THEN failure_print:= 1; + IF (ARGN(i)='-file') OR (ARGN(i)='-f') OR + (ARGN(i)='-FILE') OR (ARGN(i)='-F') + THEN print_on_file:= 0; + IF (ARGN(i)='-print') OR (ARGN(i)='-p') OR + (ARGN(i)='-PRINT') OR (ARGN(i)='-P') + THEN print_on_screen:= 0; + IF (ARGN(i)='-pr') OR (ARGN(i)='-PR') + THEN para_regu:= 1; + IF (ARGN(i)='-qc') OR (ARGN(i)='-QC') + THEN qc_calc:= 1; + IF (ARGN(i)='-hf') OR (ARGN(i)='-HF') + THEN hf_calc:= 0; + IF (ARGN(i)='-df') OR (ARGN(i)='-DF') + THEN df_calc:= 1; + IF (ARGN(i)='-hass') OR (ARGN(i)='-HASS') + THEN hass_calc:= 0; + IF (ARGN(i)='-kura') OR (ARGN(i)='-KURA') + THEN kura_calc:= 1; + IF (ARGN(i)='-evp') OR (ARGN(i)='-EVP') + THEN eigvec_prn:= 1; + IF (ARGN(i)='-n') OR (ARGN(i)='-N') THEN BEGIN + name_textfile:= ARGN(i+1); i:= i+1; + END; + i:= i+1; + END; + IF (print_on_file=1) THEN REWRITE(datafile,name_datafile); + IF hopfbftp=1 THEN BEGIN + ps:= -1; rr:= -1; END + ELSE BEGIN + ps:= -1; rr:= 1; END; + IF (failure_print=1) THEN BEGIN + IF (numparam=1) THEN WRITELN('Continuation of a stationary point.') + ELSE WRITELN('Continuation of Hopf bifurcation point.'); + WRITELN('Initial values'); + WRITELN('maxoutn1,maxoutn2,hh,ref,cfout: ',maxoutn1,maxoutn2,hh,ref,cfout); + WRITELN('xx,initxlow,initxupp,inithmax,initpref,initndir'); + FOR i:=1 TO n2 DO + WRITELN(xx[i],initxlow[i],initxupp[i], + inithmax[i.),initpref[i],initndir[i]); + WRITELN('hopfbftp',hopfbftp); + WRITELN('re1,im1',re1,im1); + WRITELN('epsfx,epsmach: ',epsfx,epsmach); + WRITELN('maxititera,maxitcorrec,maxithqr2: ',maxititera,maxitcorrec,maxithqr2); + WRITELN; + END; + END; (* level=2 *) + END; (* case *) + END; (* parainit *) + +PROCEDURE direc(m,ps,rr,nps: INTEGER; VAR nd: glnarray); + + BEGIN + IF ((ps=-1) AND (rr=1)) OR ((ps=1) AND (rr=-1)) THEN BEGIN + IF nps=-1 THEN nd[m]:=1 ELSE nd[m]:=-1; END; + IF ((ps=-1) AND (rr=-1)) OR ((ps=1) AND (rr=1)) THEN BEGIN + IF nps=-1 THEN nd[m]:=-1 ELSE nd[m]:=1; END; + END; (* direc *) + +PROCEDURE hreg(nar: glnarray; hjx: LONGREAL; VAR har: glnarray); + + BEGIN + CASE numparam OF + 1: BEGIN + IF ((nar[n1]<0) AND (har[n1]>(hjx/corrhreg))) OR + ((nar[n1]>0) AND (har[n1]<(hjx/corrhreg))) + THEN har[n1]:=hjx/corrhreg; + END; + 2: BEGIN + IF ((nar[n2]<0) AND (nar[n1]<0) AND (har[n1]>(hjx/corrhreg))) OR + ((nar[n2]<0) AND (nar[n1]>0) AND (har[n1]<(hjx/corrhreg))) OR + ((nar[n2]>0) AND (nar[n1]>0) AND (har[n1]<(hjx/corrhreg))) OR + ((nar[n2]>0) AND (nar[n1]<0) AND (har[n1]>(hjx/corrhreg))) + THEN har[n1]:=hjx/corrhreg; + END; + END; (* case *) + END; (* hreg *) + + PROCEDURE printout(xx: glnarray; pnr,ref: INTEGER); + CONST + c = ' '; d =' '; + VAR + i,j: INTEGER; + q: LONGREAL; + blok,unstb: BOOLEAN; + wr,wi: glnarray; + + BEGIN + noofpoints:= pnr; + CASE numparam OF + 1: BEGIN + i:=1; unstb:= FALSE; + REPEAT + IF (eigval[i,1]>0.0) THEN unstb:= TRUE; + i:=i+1; + UNTIL unstb OR (i>n); + IF unstb THEN kar:=1 ELSE kar:=-1; + IF (print_on_screen=1) THEN BEGIN + FOR i:=1 To n DO BEGIN + wr[i]:= eigval[i,1]; + wi[i]:= eigval[i,2]; + END; + disp(n,xx[n1],kar,0.0,xx,wr,wi); + END; (* print_on_screen *) + IF (print_on_file=1) THEN BEGIN + WRITE(datafile,xx[n1]:cfout,kar:6); + FOR i:=1 TO n DO WRITE(datafile,xx[i]:cfout,' '); + FOR i:=1 TO n-1 DO WRITE(datafile,wr[i]:cfout,' ',wi[i]:cfout,' '); + WRITELN(datafile,wr[n]:cfout,wi[n]:cfout); + END; (* print_on_file *) + END; (* case=1 *) + 2: BEGIN + IF (print_on_screen=1) THEN BEGIN + WRITELN('Point no: ',pnr:2); + WRITELN; + WRITELN('Fst. parameter: ',xx[n1]); + WRITELN('Snd. parameter: ',xx[n2]); + WRITELN; + FOR i:=1 TO n DO WRITELN(species[i],' : ',xx[i]); + WRITELN; + WRITELN('Ref: ',ref:2,d,d,d,d,d,'Omega: ',omega); + WRITELN('d_alfa: ',d_alfa,' d_omega: ',d_omega); + WRITELN; + IF (hass_calc=1) THEN BEGIN + WRITELN('************************ Hassard *************************'); + WRITELN('c1.re: ',c1.re,' c1.im: ',c1.im); + WRITELN('my2: ',my2,' beta2: ',beta2); + WRITELN('tau2: ',tau2); + WRITELN; + END; + IF (kura_calc=1) THEN BEGIN + WRITELN('************************ Kuramoto *************************'); + WRITELN('g.re: ',g_prime,' g.im: ',g_dbprime); + WRITELN('c0: ',c0kuramoto,' c2: ',c2kuramoto); + WRITELN; + END; + IF (df_calc=1) THEN BEGIN + WRITELN('************************ Diffusion ************************'); + WRITELN('d.re: ',d_prime,' d.im: ',d_dbprime); + WRITELN('c1 : ',c1kuramoto); + WRITELN; + END; + WRITELN('************************ Eigenvalues ************************'); + q:=0.0; + WRITELN(d,d,d,d,d,'Re',d,d,d,d,d,d,'Im'); + i:=1; + REPEAT + blokcheck(eigval,n,i,blok); + IF blok THEN BEGIN + WRITELN(c,d,d,eigval[i,i],d,c,c,eigval[i,i+1]); + WRITELN(c,d,d,eigval[i+1,i+1],d,c,c,eigval[i+1,i]); + i:=i+2; END + ELSE BEGIN + WRITELN(c,d,d,eigval[i,i],d,c,c,q); + i:=i+1; END; + UNTIL i=n+1; + WRITELN; + IF (eigvec_prn=1) THEN BEGIN + WRITELN('************************ Eigenvectors ************************'); + WRITELN(d,d,d,d,d,'Re',d,d,d,d,d,c,'Im'); + i:=1; + REPEAT + blokcheck(eigval,n,i,blok); + IF blok THEN BEGIN + FOR j:=1 TO n DO + WRITELN(c,d,d,eigvec[j,i],d,c,c,eigvec[j,i+1]); + WRITELN; + FOR j:=1 TO n DO + WRITELN(c,d,d,eigvec[j,i],d,c,c,-eigvec[j,i+1]); + WRITELN; + i:=i+2; END + ELSE BEGIN + FOR j:=1 TO n DO WRITELN(c,d,d,eigvec[j,i],d,c,c,q); + WRITELN; + i:=i+1; END; + UNTIL i=n+1; + WRITELN; + END; + IF (qc_calc=1) THEN BEGIN + WRITELN('*********************** Quenching Data ***********************');; + WRITELN(d,d,d,d,c,'Reconstruction',d,d,d,d,c,'Stopdata'); + WRITELN(d,d,d,d,'Amount',d,d,'Phase',d,d,'Amount',d,d,'Phase'); + FOR i:=1 TO n DO + WRITELN(species[i],d,d,d,ampvec[i]:10,c,phasevec[i]:10:2,d,d,qvec[i]:10,c,fivec[i]:10:2); + WRITELN(d,d,d,d,d,d,d,d,d,d,c,c,qd:10,c,fid:10:2); + WRITELN; + END; + WRITELN('**************************************************************'); + END; (* print_on_screen *) + IF (print_on_file=1) THEN BEGIN + WRITELN(datafile,'Point no: ',pnr:2); + WRITELN(datafile); + WRITELN(datafile,'Fst. parameter: ',xx[n1]); + WRITELN(datafile,'Snd. parameter: ',xx[n2]); + WRITELN(datafile); + FOR i:=1 TO n DO WRITELN(datafile,species[i],' : ',xx[i]); + WRITELN(datafile); + WRITELN(datafile,'Ref: ',ref:2,d,d,d,d,d,'Omega: ',omega); + WRITELN(datafile,'d_alfa: ',d_alfa,' d_omega: ',d_omega); + WRITELN(datafile); + IF (hass_calc=1) THEN BEGIN + WRITELN(datafile,'************************ Hassard *************************'); + WRITELN(datafile,'c1.re: ',c1.re,' c1.im: ',c1.im); + WRITELN(datafile,'my2: ',my2,' beta2: ',beta2); + WRITELN(datafile,'tau2: ',tau2); + WRITELN(datafile); + END; + IF (kura_calc=1) THEN BEGIN + WRITELN(datafile,'************************ Kuramoto *************************'); + WRITELN(datafile,'g.re: ',g_prime,' g.im: ',g_dbprime); + WRITELN(datafile,'c0: ',c0kuramoto,' c2: ',c2kuramoto); + WRITELN(datafile); + END; + IF (df_calc=1) THEN BEGIN + WRITELN(datafile,'************************ Diffusion ************************'); + WRITELN(datafile,'d.re: ',d_prime,' d.im: ',d_dbprime); + WRITELN(datafile,'c1 : ',c1kuramoto); + WRITELN(datafile); + END; + WRITELN(datafile,'************************ Eigenvalues ************************'); + q:=0.0; + WRITELN(datafile,d,d,d,d,d,'Re',d,d,d,d,d,d,'Im'); + i:=1; + REPEAT + blokcheck(eigval,n,i,blok); + IF blok THEN BEGIN + WRITELN(datafile,c,d,d,eigval[i,i],d,c,c,eigval[i,i+1]); + WRITELN(datafile,c,d,d,eigval[i+1,i+1],d,c,c,eigval[i+1,i]); + i:=i+2; END + ELSE BEGIN + WRITELN(datafile,c,d,d,eigval[i,i],d,c,c,q); + i:=i+1; END; + UNTIL i=n+1; + WRITELN(datafile); + IF (eigvec_prn=1) THEN BEGIN + WRITELN(datafile,'************************ Eigenvectors ************************'); + WRITELN(datafile,d,d,d,d,d,'Re',d,d,d,d,d,c,'Im'); + i:=1; + REPEAT + blokcheck(eigval,n,i,blok); + IF blok THEN BEGIN + FOR j:=1 TO n DO + WRITELN(datafile,c,d,d,eigvec[j,i],d,c,c,eigvec[j,i+1]); + WRITELN(datafile); + FOR j:=1 TO n DO + WRITELN(datafile,c,d,d,eigvec[j,i],d,c,c,-eigvec[j,i+1]); + WRITELN(datafile); + i:=i+2; END + ELSE BEGIN + FOR j:=1 TO n DO WRITELN(datafile,c,d,d,eigvec[j,i],d,c,c,q); + WRITELN(datafile); + i:=i+1; END; + UNTIL i=n+1; + WRITELN(datafile); + END; + IF (qc_calc=1) THEN BEGIN + WRITELN(datafile,'*********************** Quenching Data ***********************');; + WRITELN(datafile,d,d,d,d,c,'Reconstruction',d,d,d,d,c,'Stopdata'); + WRITELN(datafile,d,d,d,d,'Amount',d,d,'Phase',d,d,'Amount',d,d,'Phase'); + FOR i:=1 TO n DO + WRITELN(datafile,species[i],d,d,d,ampvec[i]:10,c,phasevec[i]:10:2,d,d,qvec[i]:10,c,fivec[i]:10:2); + WRITELN(datafile,d,d,d,d,d,d,d,d,d,d,c,c,qd:10,c,fid:10:2); + WRITELN(datafile); + END; + WRITELN(datafile,'**************************************************************'); + END; (* print_on_file *) + END; (* case=2 *) + END; (* numparam *) + END; (* printout *) + +PROCEDURE stability(tp: BOOLEAN; xx: glnarray; VAR re,im: LONGREAL); + + CONST + reeps = 5E-2; + + VAR + fv: glnarray; + tt,gg: glnpbynp; + blk: BOOLEAN; + i,j,k,tmx: INTEGER; + maxre,maxim: LONGREAL; + + BEGIN + tt:= jacobi; tmx:=maxithqr2; + fctn(TRUE,tp,xx,fv,gg); + hqr2alg(n,ref,gg,tt,tmx,epshqr2,TRUE,FALSE,TRUE); + IF (failure_print=1) THEN BEGIN + WRITELN; WRITELN('Eigenvalues'); + FOR i:=1 TO n DO WRITELN(i,' eigv: ',gg[i,1],gg[i,2]); + WRITELN; END; + IF (ABS(re)0.0) THEN BEGIN + i:=1; + REPEAT + blk:= (gg[i,2]<>0.0); + i:=i+1; + UNTIL blk OR (i>n); + IF blk THEN BEGIN + i:=i-1; + maxim:=ABS(1.0-ABS(im/gg[i,2])); j:=i; + FOR k:=i TO n DO BEGIN + IF gg[k,2]<>0.0 THEN + IF (ABS(1.0-ABS(im/gg[k,2]))0 THEN alarm(0,'Interpol_dif: re1*re2>0'); + IF re1>0.0 THEN sigmin:=1 ELSE sigmin:=-1; + IF re2>0.0 THEN sigmax:=1 ELSE sigmax:=-1; + IF im1<>0.0 THEN BEGIN re12:=re1; im12:=im1; END + ELSE IF im2<>0.0 THEN BEGIN re12:= re2; im12:=im2; END + ELSE BEGIN re12:= re1; im12:=0; END; + IF (failure_print=1) THEN WRITELN('Interpol_dif'); + REPEAT + FOR i:=1 TO n2 DO xmid[i]:=(xmin[i]+xmax[i])*0.5; + tt:= jacobi; tmx:= maxithqr2; + fctn(TRUE,TRUE,xmid,fv,gg); + hqr2alg(n,ref,gg,tt,tmx,epshqr2,TRUE,FALSE,TRUE); + re12:= gg[1,1]; im12:= gg[1,2]; + IF re12>0.0 THEN sign:=1 ELSE sign:=-1; + IF sign=sigmin THEN BEGIN + xmin:=xmid; re1:=re12; im1:=im12; END + ELSE BEGIN + xmax:=xmid; re2:=re12; im2:=im12; END; + tmx:= tmx +1; + OK:=((im1<>0) AND (im2<>0)) OR (tmx> maxitintpol); + UNTIL OK; + + IF tmx>maxitintpol THEN BEGIN + WRITELN('Min: P1= ',xmin[n1]); + WRITELN(' re1= ',re1,' im1= ',im1); + WRITELN; + WRITELN('Max: P1= ',xmax[n1]); + WRITELN(' re2= ',re2,' im2= ',im2); + alarm(0,'Interpol_dif: tmx> maxitintpol. Too many iteration.'); + END; + IF re1>0 THEN FOR i:=1 TO n2 DO q[i]:= (xmax[i]-xmin[i])*0.5 + ELSE FOR i:=1 TO n2 DO q[i]:= (xmin[i]-xmax[i])*0.5; + FOR i:=1 TO n2 DO xmid[i]:= (xmin[i]+xmax[i])*0.5; + tmx:= 0; + REPEAT + FOR i:=1 TO n2 DO q[i]:= q[i]*0.5; + tt:= jacobi; tmx:= maxithqr2; + fctn(TRUE,TRUE,xmid,fv,gg); + hqr2alg(n,ref,gg,tt,tmx,epshqr2,TRUE,FALSE,TRUE); + re12:= gg[1,1]; im12:= gg[1,2]; + + OK:= ((ABS(q[n1])>epsmach) AND (ABS(re12)>epsbisecr)); + IF (failure_print=1) THEN BEGIN + WRITELN; FOR i:=1 TO n2 DO WRITELN(xmid[i]); + WRITELN; WRITELN('re: ',re12,' im: ',im12); END; + tmx:= tmx+1; + IF OK THEN + IF (re12>0.0) THEN FOR i:=1 TO n2 DO xmid[i]:= xmid[i]+q[i] + ELSE FOR i:=1 TO n2 DO xmid[i]:= xmid[i]-q[i]; + UNTIL NOT(OK) OR (tmx>maxitbisec); + IF (tmx>maxitbisec) THEN alarm(1,'Interpol_dif: (tmx>maxitbisec)'); + + hv1:= (xmax[n1])-(xmid[n1]); + hv2:= (xmid[n1])-(xmin[n1]); + dny:= (xmid[n1]*(EXP(LN(epsmach)/3.0))); + + IF (hv1 maxitcorrec. Not enough iterations'); END; + END; (* correc *) + + PROCEDURE newx(bt,hm,xvec,fpkt: glnarray; hh: LONGREAL; + k,nout: INTEGER; VAR dxdt,nd: glnarray; + VAR madms,kout: INTEGER; VAR h: LONGREAL); + + LABEL + 10; + + VAR + i: INTEGER; + dxk2: LONGREAL; + + BEGIN + dxk2:=1; FOR i:=1 TO n1 DO dxk2:=dxk2+sqr(bt[i]); + dxdt[k]:=1/(sqrt(dxk2)*nd[k]); h:=hh; + FOR i:=1 TO n1 DO BEGIN + IF i<>k THEN dxdt[i]:=bt[i]*dxdt[k]; + IF i<>n1 THEN IF dxdt[i]<0 THEN nd[i]:=-1 ELSE nd[i]:=1; + IF (h*ABS(dxdt[i])>hm[i]) THEN BEGIN + madms:=0; h:=hm[i]/ABS(dxdt[i]); END; + END; + IF nout<=(kout+3) THEN GOTO 10; + IF (h*ABS(dxdt[k]) <= 0.8*ABS(xvec[k]-fpkt[k])) THEN GOTO 10; + IF ((fpkt[k]-xvec[k])*nd[k])<=0 THEN GOTO 10; madms:=0; + IF (h*ABS(dxdt[k])<= ABS(xvec[k]-fpkt[k])) THEN GOTO 10; + h:=ABS(xvec[k]-fpkt[k])/ABS(dxdt[k]); kout:=nout; + 10:END; (* newx *) + + PROCEDURE adam(d: glnarray; VAR madms: INTEGER; h:LONGREAL; + VAR x:glnarray; VAR der:glnpbynp); + + CONST + mxadms = 4; + + VAR + i,j:integer; + + BEGIN + FOR i:=3 DOWNTO 1 DO BEGIN + FOR j:=1 TO n1 DO der[i+1,j]:=der[i,j]; END; + madms:=madms+1; + IF madms>mxadms THEN madms:=mxadms; + IF madms>4 THEN madms:=4; + FOR i:=1 TO n1 DO BEGIN + der[1,i]:=d[i]; + CASE madms OF + 1:x[i]:=x[i]+h*der[1,i]; + 2:x[i]:=x[i]+0.5*h*(3*der[1,i]-der[2,i]); + 3:x[i]:=x[i]+h*(23*der[1,i]-16*der[2,i] + +5*der[3,i])/12; + 4:x[i]:=x[i]+h*(55*der[1,i]-59*der[2,i]+37*der[3,i] + -9*der[4,i])/24; + END; + END; + END; (* adam *) + + PROCEDURE itera(tp: BOOLEAN; VAR xvec: glnarray); + + VAR + i,j,nn: INTEGER; + cont: BOOLEAN; + dx,x,xdx,x2dx,fx,fxdx,fx2dx: glnarray; + Jac: glnpbynp; + int: glindx; + det,pp0,pp1,pp2,tmin: LONGREAL; + + PROCEDURE sqrtlength(fv: glnarray; VAR len: LONGREAL); + VAR + sum: LONGREAL; + i: INTEGER; + BEGIN + sum:= 0.0; + FOR i:=1 TO n DO sum:= sum+ fv[i]*fv[i]; + len:= SQRT(sum); + END; (* sqrtlength *) + + BEGIN + x:= xvec; xdx:= xvec; x2dx:= xvec; dx:= xvec; + i:=0; cont:= TRUE; + fctn(TRUE,tp,x,fx,Jac); + nn:= 0; + FOR j:=1 TO n DO IF ABS(fx[j])1.0 THEN tmin:= 1.0; + FOR j:=1 TO n DO x[j]:= x[j]+tmin*dx[j]; + fctn(TRUE,tp,x,fx,Jac); + nn:= 0; i:= i+1; + FOR j:=1 TO n DO IF ABS(fx[j])maxititera. Not enough iterations'); END; + END; + END; (* itera *) + + +PROCEDURE hf_derpar(xx: glnarray; VAR initndir,inithmax,xmin,xmax: glnarray; + VAR re1,re2,im1,im2: LONGREAL; bifpar: INTEGER); + LABEL + 10; + + VAR + first_pkt,pref,ndir,beta,xlow,xupp,hmax,fu,xxx,dxdt:glnarray; + sign,inhj,i,j,l,m,k,nc,kout,madms,nout,k11: INTEGER; + gg: glnpbynp; + h,hjx,re12,im12:LONGREAL; + fail,typpar,notback,newd: BOOLEAN; + + + PROCEDURE initderpar(xivec,ind,ixl,ixu,ipf,ihm: glnarray; bf: INTEGER; + VAR de: glnpbynp; VAR xvec,nd,xl,xu,pf,hm: glnarray; + VAR tp: BOOLEAN; VAR re1,re2,im1,im2: LONGREAL; + VAR sigmin,sigmax,kout,nout,madms, + nc,k11: INTEGER); + + VAR + i,j: INTEGER; + + BEGIN + re1:=0; re2:=0; im1:=0; im2:=0; sigmin:=0; sigmax:=0; + kout:=0; nout:=0; madms:=0; nc:=1; k11:=0; + FOR i:=1 TO 4 DO FOR j:=1 TO n1 DO de[i,j]:=0; + FOR i:=1 TO n DO BEGIN + xvec[i]:=xivec[i]; nd[i]:=ind[i]; xl[i]:=ixl[i]; + xu[i]:=ixu[i]; pf[i]:=ipf[i]; + hm[i]:=ihm[i]; END; + xvec[n1]:=xivec[bf]; nd[n1]:=ind[bf]; + xl[n1]:=ixl[bf]; xu[n1]:=ixu[bf]; + pf[n1]:=ipf[bf]; hm[n1]:=ihm[bf]; + IF bf=n1 THEN BEGIN + xvec[n2]:=xivec[n2]; nd[n2]:=ind[n2]; + tp:=TRUE END + ELSE IF bf=n2 THEN BEGIN + xvec[n2]:=xivec[n1]; + tp:=FALSE; END; + END; (* initderpar *) + + PROCEDURE newderp(typpar: BOOLEAN; sign: INTEGER; re12,im12: LONGREAL; + VAR inithmax,first_pkt,xmin,xmax,hmax,xxx: glnarray; + VAR nout,sigmin,sigmax: INTEGER; + VAR re1,im1,re2,im2: LONGREAL; VAR nde: BOOLEAN); + + + BEGIN + IF typpar THEN BEGIN + IF nout=1 THEN BEGIN + first_pkt:=xxx; xmin:=xxx; + sigmin:=sign; re1:=re12; im1:=im12; + nde:=FALSE; END + ELSE + IF sign=sigmin THEN BEGIN + xmin:=xxx; re1:=re12; im1:=im12; nde:=FALSE; END + ELSE BEGIN + xmax:=xxx; re2:=re12; im2:=im12; sigmax:=sign; nde:=TRUE; END; + END + ELSE BEGIN + IF nout=1 THEN BEGIN + first_pkt:=xxx; xmin:=xxx; + sigmin:=sign; re1:=re12; im1:=im12; + nde:=FALSE; END + ELSE BEGIN + xmax:=xxx; re2:=re12; im2:=im12; sigmax:=sign; + IF nout>=maxoutn2 THEN nde:=TRUE ELSE nde:=FALSE; END; + END; + END; (* newderp *) + + + PROCEDURE parareg(pold: LONGREAL; xmax: glnarray; + VAR xx: glnarray; VAR fail: BOOLEAN); + VAR + pnew: LONGREAL; + + BEGIN + fail:= FALSE; pnew:= xx[n2]; + xx:= xmax; xx[n2]:= (pold+pnew)*0.5; + fail:= (ABS(ABS(pold)-ABS(pnew)) maxoutn1) THEN BEGIN + IF NOT (para_regu=1) THEN alarm(0,'DERPAR: nout>maxoutn1'); + parareg(paraold, xmax, xx, fail); + IF (failure_print=1) THEN WRITELN('Old, new parameter: ',paraold,xx[n2]); + IF fail THEN alarm(0,'DERPAR: nout>maxoutn1 and ABS(ABS(pold)-ABS(pnew))xupp[i]) THEN BEGIN + IF (failure_print=1) THEN BEGIN + alarm(1,'DERPAR: max/min values have been reached'); + alarm(1,'x xmin xmax'); + WRITELN(i,' ',xxx[i],' ',xlow[i],' ',xupp[i]); END; + alarm(0,'DERPAR: max/min'); + END; + + stability(typpar,xxx,re12,im12); + IF (failure_print=1) THEN BEGIN + alarm(1,'DERPAR: New x'); + WRITELN('No. in iteration: ',nout); + FOR i:=1 TO n2 DO WRITELN(xxx[i]); + WRITELN; + WRITELN('re: ',re12,' im: ',im12); END; + IF re12>0.0 THEN sign:= 1 ELSE sign:=-1; + newderp(typpar,sign,re12,im12,inithmax,first_pkt,xmin,xmax, + hmax,xxx,nout,sigmin,sigmax,re1,im1,re2,im2,newd); + + IF NOT(newd) THEN BEGIN + fctn(TRUE,typpar,xxx,fu,gg); + gause(n,gg,pref,m,k,beta,fu); + IF m=0 THEN alarm(0,'DERPAR: m=0'); + IF k11<>k THEN BEGIN + madms:=0; k11:=k; END; + IF typpar THEN BEGIN + hjx:=xxx[n1];hreg(ndir,hjx,hmax); END; + newx(beta,hmax,xxx,first_pkt,hh,k,nout,dxdt,ndir,madms,kout,h); + adam(dxdt,madms,h,xxx,der); + END; + UNTIL newd; + + IF typpar THEN + BEGIN + xmin[n2]:=xx[n2]; xmax[n2]:=xx[n2]; + hjx:=xxx[n1]; + hreg(initndir,hjx,inithmax); + END + ELSE + BEGIN + xmin[n2]:=xmin[n1]; xmin[n1]:=xx[n1]; + xmax[n2]:=xmax[n1]; xmax[n1]:=xx[n1]; + END; + END; (* hf_derpar *) + +PROCEDURE quenchvec(ref: INTEGER; xconc: glnarray; P,IP: glnpbynp); + BEGIN + compamppha(n,P,ampvec,phasevec); + stopdata(n,ref,xconc,IP,qvec,fivec,qd,fid); + END; (* quenchvec *) + +PROCEDURE hf_derpar_driver; + + VAR + i,j,tmx: INTEGER; + norm: LONGREAL; + w,w1,z: fcomplex; + fv: glnarray; + P,Q,D,E,Jac: glnpbynp; + + BEGIN + init; oaddr:= signal(sigint,Baddress(inthandler)); + parainit(1); hopfinit; derivsinit; parainit(2); + i:= 0; + REPEAT + i:=i+1; + hf_derpar(xx,initndir,inithmax,xmin,xmax, + re1,re2,im1,im2,n1); + interpol_dif(n,xmin,xmax,re1,im1,re2,im2); + d_alfa:= re2; d_omega:= im2; + fctn(TRUE,TRUE,xmin,fv,Jac); + D:=Jac; + tmx:=maxithqr2; + hqr2alg(n,ref,D,P,tmx,epshqr2,FALSE,TRUE,TRUE); + eigval:= D; eigvec:=P; + z.re:= P[ref,1]; z.im:= -P[ref,2]; + Cnorm(z,norm); + FOR j:=1 TO n DO BEGIN + w.re:= P[j,1]; w.im:= P[j,2]; + Cmul(w,z,w1); + RCmul(w1,1/norm,w); + P[j,1]:=w.re; P[j,2]:=w.im; + END; + transponer(n,E,Jac); + tmx:=maxithqr2; + hqr2alg(n,ref,E,Q,tmx,epshqr2,FALSE,TRUE,TRUE); + adjeigvec:=Q; + inversmatrix(n,P,Q); + inverseigvec:= Q; + + IF (hf_calc=1) THEN BEGIN + hopf(xmin,eigval,E,eigvec,inverseigvec,c1,omega); + IF (hass_calc=1) THEN hassard; + IF (kura_calc=1) THEN kuramoto; + IF (df_calc=1) THEN ginzlandif; + END; + IF (qc_calc=1) THEN BEGIN + compamppha(n,eigvec,ampvec,phasevec); + stopdata(n,ref,xmin,inverseigvec,qvec,fivec,qd,fid); + END; + paraold:= xmax[n2]; + printout(xmin,i,ref); + hreg(initndir,xmin[n1],inithmax); + IF (xmax[n2]-maxoutn2*inithmax[n2])<0 + THEN inithmax[n2]:=inithmax[n2]/10; + xx:=xmax; + hf_derpar(xx,initndir,inithmax,xmin,xmax, + re1,re2,im1,im2,n2); + IF re2>0.0 THEN sigmax:=1 ELSE sigmax:= -1; + direc(n1,ps,rr,sigmax,initndir); + xx:=xmax; + UNTIL (i>=maxnoofp); + IF (print_on_file=1) THEN close_datafile(0) + ELSE close_datafile(1); + alarm(1,'HOPF_DRIVER: PROGRAM END'); + END; (* hopfderp_driver *) + + + PROCEDURE sp_derpar(xx,xlow,xupp,hmax,pref,ndir: glnarray); + + VAR + i,inhj,k,kout,k11,m,madms,nc,nout,tmx: INTEGER; + h,hjx: LONGREAL; + gg: glnpbynp; + beta,dxdt,fpkt,fu: glnarray; + notback,stop: BOOLEAN; + + + BEGIN + IF (failure_print=1) THEN BEGIN + alarm(1,'Variables before iteration'); + FOR i:=1 TO n1 DO WRITELN(xx[i]); WRITELN; END; + kout:=0; nout:=0; madms:=0; nc:=1; k11:=0; + itera(TRUE,xx); + IF (failure_print=1) THEN BEGIN + alarm(1,'Variables after iteration'); + FOR i:=1 TO n1 DO WRITELN(xx[i]); WRITELN; END; + + WHILE noutxupp[i])) THEN + BEGIN + IF (failure_print=1) THEN + BEGIN + alarm(1,'SP_DERPAR: max/min values have been reached'); + alarm(1,'x xmin xmax'); + WRITELN(i,' ',xx[i],' ',xlow[i],' ',xupp[i]); + END; + alarm(0,'Sp_Derpar: max/min'); + END; + + IF nout=1 THEN fpkt:=xx; + eigvec:= jacobi; tmx:= maxithqr2; + fctn(TRUE,TRUE,xx,fu,eigval); + hqr2alg(n,ref,eigval,eigvec,tmx,epshqr2,TRUE,FALSE,TRUE); + printout(xx,nout,ref); + + fctn(TRUE,TRUE,xx,fu,gg); + gause(n,gg,pref,m,k,beta,fu); + IF (failure_print=1) THEN BEGIN + WRITELN('2. From Gause proc: m,k: ',m,' ',k); + WRITELN; + END; + IF m=0 THEN alarm(0,'SP_DERPAR: m=0'); + IF k11<>k THEN BEGIN + madms:=0; k11:=k; END; + IF (para_regu=1) THEN BEGIN + hjx:= xx[n1]; + hreg(ndir,hjx,hmax); + END; + newx(beta,hmax,xx,fpkt,hh,k,nout,dxdt,ndir,madms,kout,h); + adam(dxdt,madms,h,xx,der); + END; (* while *) + IF nout>=maxnoofp THEN alarm(1,'SP_DERPAR: nout>maxnoofp'); + END; (* sp_derpar *) + +PROCEDURE sp_derpar_driver; + + VAR + i,j: INTEGER; + + BEGIN + init; oaddr:= signal(sigint,Baddress(inthandler)); + parainit(1); derivsinit; derpinit; parainit(2); + sp_derpar(xx,initxlow,initxupp,inithmax,initpref,initndir); + IF (print_on_file=1) THEN close_datafile(0) + ELSE close_datafile(1); + alarm(1,'DERPAR_DRIVER: PROGRAM END'); + END; (* sp_derpar_driver *) diff --git a/DPHF/dphfcalc.proc b/DPHF/dphfcalc.proc new file mode 100644 index 0000000..b89bc2c --- /dev/null +++ b/DPHF/dphfcalc.proc @@ -0,0 +1,174 @@ +PROCEDURE hopf(conc: glnarray; D,E,P,Q:glnpbynp; + VAR c1: fcomplex; VAR omega:LONGREAL); + + + VAR + fv,h11,w11: glnarray; + dJ,S:gldjacobian; + ddJ,dS: glddjacobian; + a,b,c,det,g11norm,g02norm,hjx,wnorm:LONGREAL; + ch1,ch2,ch3,g11,g02,g20,g21,g20_g11,gg21, + w,w1,w2,z1,z2:fcomplex; + G101,G110,h20,w20: ARRAY [1..n] of fcomplex; + i1,i2,i3,k,tmx,dyno:INTEGER; + Jac:glnpbynp; + blok:BOOLEAN; + + PROCEDURE smat(i1,i2,i3: INTEGER; VAR Q,P: glnpbynp;SU: gldjacobian;VAR sum: LONGREAL); + + VAR + j1,j2,j3: INTEGER; + + BEGIN + sum:=0; + FOR j1:=1 TO n DO FOR j2:=1 TO n DO FOR j3:=1 TO n DO + sum:= sum+Q[i1,j1]*(SU[j1,j2,j3]*(P[j2,i2]*P[j3,i3])); + END; (* smat *) + + + PROCEDURE dsmat(i1,i2,i3,i4: INTEGER; Q,P: glnpbynp;dSU: glddjacobian;VAR sum: LONGREAL); + + VAR + j1,j2,j3,j4: INTEGER; + + BEGIN + sum:=0; + FOR j1:=1 TO n DO + FOR j2:=1 TO n DO + FOR j3:=1 TO n DO + FOR j4:=1 TO n DO + sum:= sum+Q[i1,j1]*(dSU[j1,j2,j3,j4]*(P[j2,i1]*(P[j3,i3]*P[j4,i4]))); + END; (* dsmat *) + + BEGIN + Complex(0.0,0.0,g21); + Complex(0.0,0.0,gg21); + dJ:= derivsjacobian; + IF NeedDDJac THEN ddJ:= derivsdjacobian; + fctn(TRUE,TRUE,conc,fv,Jac); + djacobian(conc,dJ); + IF NeedDDJac THEN ddjacobian(conc,ddJ); + + omega:=D[2,1]; + FOR i1:=1 TO n DO FOR i2:=1 TO n DO FOR i3:=1 TO n DO + BEGIN + smat(i1,i2,i3,Q,P,dJ,hjx); + S[i1,i2,i3]:=hjx; END; + + g11.re:=(S[1,1,1]+S[1,2,2])/4; + g11.im:=(S[2,1,1]+S[2,2,2])/4; + g02.re:=(S[1,1,1]-S[1,2,2]-2*S[2,1,2])/4; + g02.im:=(S[2,1,1]-S[2,2,2]+2*S[1,1,2])/4; + g20.re:=(S[1,1,1]-S[1,2,2]+2*S[2,1,2])/4; + g20.im:=(S[2,1,1]-S[2,2,2]-2*S[1,1,2])/4; + + + IF NeedDDJac THEN BEGIN + dsmat(1,1,1,1,Q,P,ddJ,dS[1,1,1,1]); + dsmat(1,1,2,2,Q,P,ddJ,dS[1,1,2,2]); + dsmat(2,1,1,2,Q,P,ddJ,dS[2,1,1,2]); + dsmat(2,2,2,2,Q,P,ddJ,dS[2,2,2,2]); + dsmat(2,1,1,1,Q,P,ddJ,dS[2,1,1,1]); + dsmat(2,1,2,2,Q,P,ddJ,dS[2,1,2,2]); + dsmat(1,1,1,2,Q,P,ddJ,dS[1,1,1,2]); + dsmat(1,2,2,2,Q,P,ddJ,dS[1,2,2,2]); + + gg21.re:= (dS[1,1,1,1]+dS[1,1,2,2]+dS[2,1,1,2]+dS[2,2,2,2])/8; + gg21.im:= (dS[2,1,1,1]+dS[2,1,2,2]-dS[1,1,1,2]-dS[1,2,2,2])/8; + END; + + dyno:= n; + IF (dyno>2) THEN BEGIN + FOR k:=3 TO n DO BEGIN + h11[k]:=(S[k,1,1]+S[k,2,2])/4; + h20[k].re:=(S[k,1,1]-S[k,2,2])/4; + h20[k].im:=-S[k,1,2]/2; + + G110[k].re:=(S[1,1,k]+S[2,2,k])/2; + G110[k].im:=(S[2,1,k]-S[1,2,k])/2; + G101[k].re:=(S[1,1,k]-S[2,2,k])/2; + G101[k].im:=(S[1,2,k]+S[2,1,k])/2; + END; + k:=3; + WHILE k<=n DO + BEGIN + a:=D[k,k]; c:=-2*omega; blok:=FALSE; + IF k2 *) + + IF NeedDDJac THEN Cadd(g21,gg21,g21); + + Cmul(g20,g11,g20_g11); + c1.re:=(-g20_g11.im/omega+g21.re)/2; + Cnorm(g11,g11norm); Cnorm(g02,g02norm); + c1.im:=((g20_g11.re-2*g11norm-g02norm/3)/omega+g21.im)/2; +END; (* Hopf *) + +PROCEDURE hassard; + BEGIN + my2:=-c1.re/d_alfa; + tau2:=-(c1.im+my2*d_omega)/omega; + beta2:=2*c1.re; + END; (* hassard *) + +PROCEDURE kuramoto; + BEGIN + g_prime:= -4*c1.re; g_dbprime:= -4*c1.im; + c0kuramoto:= d_omega/d_alfa; + c2kuramoto:= g_dbprime/g_prime; + END; (* kuramoto *) + +PROCEDURE ginzlandif; + VAR + i: INTEGER; + BEGIN + d_prime:= 0.0; d_dbprime:= 0.0; + FOR i:=1 TO n DO BEGIN + d_prime:= d_prime+dif[i]/2*(inverseigvec[1,i]*eigvec[i,1]+inverseigvec[2,i]*eigvec[i,2]); + d_dbprime:= d_dbprime+dif[i]/2*(inverseigvec[2,i]*eigvec[i,1]-inverseigvec[1,i]*eigvec[i,2]); + END; + c1kuramoto:= d_dbprime/d_prime; + END; (* ginzlandif *) + diff --git a/DPHF/gause.proc b/DPHF/gause.proc new file mode 100644 index 0000000..d8a9977 --- /dev/null +++ b/DPHF/gause.proc @@ -0,0 +1,82 @@ + +PROCEDURE GAUSE (n: INTEGER; gg: glnpbynp; pref: glnarray; + VAR m,k:INTEGER; VAR beta,b: glnarray); + +LABEL 2; +(* +CONST + eps = 1L-20; + *) + + +VAR + irr,irk:glindx; + i,j,id,ir,is:INTEGER; + p,amax:LONGREAL; + xx,yy:glnarray; + +BEGIN + id:=1; + m:=1; + FOR i:=1 TO (n+1) DO + BEGIN + irk[i]:=0; + irr[i]:=0; + END; +2:ir:=1; + is:=1; + amax:=0; + FOR i:=1 TO n DO + BEGIN + IF irr[i]=0 THEN + FOR j:=1 TO (n+1) DO + BEGIN + p:=pref[j]*abs(gg[i,j]); + IF (p-amax)>0 THEN + BEGIN + ir:=i; + is:=j; + amax:=p; + END; + END; + END; + IF amax0 THEN + BEGIN + irr[ir]:=is; + FOR i:=1 TO n DO + BEGIN + IF (i<>ir) AND (gg[i,is] <>0) THEN + BEGIN + p:=gg[i,is]/gg[ir,is]; + FOR j:=1 TO (n+1) DO gg[i,j]:=gg[i,j]-p*gg[ir,j]; + gg[i,is]:=0; + b[i]:=b[i]-p*b[ir]; + END; + END; + id:=id+1; + IF id<=n THEN GOTO 2; + FOR i:=1 TO n DO + BEGIN + ir:=irr[i]; + xx[ir]:=b[i]/gg[i,ir]; + irk[ir]:=1; + END; + k:=0; + REPEAT + k:=k+1; + UNTIL irk[k]=0; + FOR i:=1 TO n DO + BEGIN + ir:=irr[i]; + yy[ir]:=-gg[i,k]/gg[i,ir]; + END; + FOR i:=1 TO (n+1) DO + BEGIN + b[i]:=xx[i]; + beta[i]:=yy[i]; + END; + b[k]:=0; + beta[k]:=0; + END; + END; (* gause *) diff --git a/DPHF/heigvqr.proc b/DPHF/heigvqr.proc new file mode 100644 index 0000000..5cd833b --- /dev/null +++ b/DPHF/heigvqr.proc @@ -0,0 +1,635 @@ + +PROCEDURE blokcheck (A: glnpbynp; n,i: INTEGER; + VAR blok: BOOLEAN); + + BEGIN + IF i=n THEN blok:=FALSE ELSE + IF (ABS(A[i,i+1]-A[i+1,i])>epsblk) AND + (ABS(A[i,i]-A[i+1,i+1])<=epsblk) + THEN blok:=TRUE + ELSE blok:=FALSE; + END; (* blokcheck *) + + PROCEDURE normalizingmatrix(n: INTEGER; A: glnpbynp; fixedref: BOOLEAN; + VAR ref: INTEGER; VAR V: glnpbynp); + + VAR + j,col: INTEGER; + c1,c2,c3: fcomplex; + sqrnorm,norm,max: LONGREAL; + blok: BOOLEAN; + + BEGIN + col:=1; + REPEAT + IF NOT(fixedref) THEN BEGIN + ref:=1; + Complex(V[ref,col],V[ref,col+1],c1); Cnorm(c1,max); + FOR j:=2 TO n DO BEGIN + Complex(V[j,col],V[j,col+1],c2); Cnorm(c2,sqrnorm); + IF sqrnorm>max THEN BEGIN + ref:=j; max:=sqrnorm; END; + END; + END; + blokcheck(A,n,col,blok); + IF blok THEN BEGIN + Complex(V[ref,col],V[ref,col+1],c1); + FOR j:=1 TO n DO BEGIN + Complex(V[j,col],V[j,col+1],c2); + Cdiv(c2,c1,c3); + V[j,col]:= c3.re; V[j,col+1]:= c3.im; + END; + col:=col+2; + END + ELSE BEGIN + norm:=ABS(V[ref,col]); + IF norm<>0.0 THEN FOR j:=1 TO n DO V[j,col]:=V[j,col]/norm; + col:=col+1; + END; + UNTIL col>n; + END; (* normalizingmatrix *) + + PROCEDURE permutation (n: INTEGER; VAR P,A,B :glnpbynp; + kolon: BOOLEAN); + + VAR + nr:glindx; + blok:BOOLEAN; + max,x:LONGREAL; + im,j,ki,u,i,k,ii:INTEGER; + AA: glnpbynp; + + BEGIN + AA:= A; + FOR i:=1 TO n DO BEGIN + nr[i]:=i; + FOR k:=1 TO n DO P[i,k]:=0; END; + i:=1; ii:=1; ki:=1; + WHILE i0 THEN BEGIN + A[i+1,i]:=A[i,i+1]; A[i,i+1]:=-A[i+1,i]; + AA[i+1,i]:=AA[i,i+1]; AA[i,i+1]:=-AA[i+1,i]; + FOR j:=1 TO n DO B[j,i+1]:=-B[j,i+1]; END + ELSE BEGIN + A[i+1,i]:=-A[i,i+1]; + AA[i+1,i]:=-AA[i,i+1]; END; + j:=i; + FOR k:=ii TO (ii+1) DO BEGIN + x:= AA[k,k]; AA[k,k]:= AA[j,j]; AA[j,j]:= x; + u:=nr[k]; nr[k]:=nr[j]; nr[j]:=u; + j:=j+1; END; + IF ii>1 THEN BEGIN + IF AA[ii,ii]>AA[1,1] THEN BEGIN + j:=ii; + FOR k:=1 TO 2 DO BEGIN + x:= AA[k,k]; AA[k,k]:= AA[j,j]; AA[j,j]:= x; + u:=nr[k]; nr[k]:=nr[j]; nr[j]:=u; + j:=j+1; END; + END; + END; + ki:=i; i:=i+2; ii:=ii+2; + END + ELSE i:=i+1; + END; (* while *) + + IF n>3 THEN BEGIN + REPEAT + im:= ii; i:= ii; max:= AA[im,im]; + REPEAT + i:=i+1; + IF AA[i,i]>max THEN BEGIN + im:=i; max:=AA[i,i]; END; + UNTIL i>=n; + IF im>ii THEN BEGIN + x:= AA[ii,ii]; u:= nr[ii]; AA[ii,ii]:= max; nr[ii]:= nr[im]; + AA[im,im]:= x; nr[im]:= u; END; + ii:= ii+1; + UNTIL ii>=n; + END; + FOR i:=1 TO n DO + IF kolon THEN P[nr[i],i]:=1 + ELSE P[i,nr[i]]:=1; + END; (* permutation *) + + + PROCEDURE produkt (n: INTEGER; VAR C:glnpbynp; A,B:glnpbynp); + + VAR + x:LONGREAL; + i,l,k:INTEGER; + + BEGIN + FOR i:=1 TO n DO + FOR l:=1 TO n DO + BEGIN + x:=0; + FOR k:=1 TO n DO x:=x+A[i,k]*B[k,l]; + C[i,l]:=x; + END; + END; (* produkt *) + + PROCEDURE transponer (n: INTEGER; VAR Q:glnpbynp; P:glnpbynp); + + VAR + i,k:INTEGER; + + BEGIN + FOR i:=1 TO n DO + FOR k:=1 TO n DO Q[i,k]:=P[k,i]; + END; (* transponer *) + +PROCEDURE ombytning (n: INTEGER; VAR A,B: glnpbynp); + +VAR + PR,PS: glnpbynp; + +BEGIN + permutation(n,PS,A,B,true); + produkt(n,B,B,PS); + transponer(n,PR,PS); + produkt(n,A,PR,A); + produkt(n,A,A,PS); +END; (* ombytning *) + +PROCEDURE balance(n,b:INTEGER; VAR a:glnpbynp; + VAR low,hi:INTEGER; VAR d:glnarray); + (* reduce the norm of a[1..n,1..n] by exact diagonal *) + (* similarity transformations stored in d[1..n] *) + + LABEL 10,20,30,40,50; + + VAR + i,j,k,l: INTEGER; + b2,c,f,g,r,s: LONGREAL; + noconv: BOOLEAN; + + PROCEDURE exc(m:INTEGER); + VAR + f: LONGREAL; i: INTEGER; + BEGIN + d[m]:=j; + IF j<>m THEN BEGIN + FOR i:=1 TO k DO BEGIN + f:=a[i,j]; a[i,j]:=a[i,m]; a[i,m]:=f; END; + FOR i:=l TO n DO BEGIN + f:=a[j,i]; a[j,i]:=a[m,i]; a[m,i]:=f; END; + END; (* j<>m *) + END; (* exc *) + + BEGIN + b2:=b*b; l:=1; k:=n; + + (* search for rows isolating an eigenvalue and push them down *) + + 10: + FOR j:=k DOWNTO 1 DO BEGIN + r:=0; + FOR i:=1 TO j-1 DO r:=r+ABS(a[j,i]); + FOR i:=j+1 TO k DO r:=r+ABS(a[j,i]); + IF r=0 THEN BEGIN + exc(k); k:=k-1; GOTO 10 END; + END; (* j *) + + (* search for columns isolating an eigenvalue and push them down *) + + 20: + FOR j:=l TO k DO BEGIN + c:=0; + FOR i:=l TO j-1 DO c:=c+ABS(a[i,j]); + FOR i:=j+1 TO k DO c:=c+ABS(a[i,j]); + IF c=0 THEN BEGIN + exc(l); l:=l+1; GOTO 20 END; + END; (* j *) + + (* now balance the submatrix in rows l though k *) + + low:=l; hi:=k; + FOR i:=l TO k DO d[i]:=1; + + 30: + noconv:=FALSE; + FOR i:=l TO k DO BEGIN + r:=0; c:=0; + FOR j:=l TO i-1 DO BEGIN + c:=c+ABS(a[j,i]); r:=r+ABS(a[i,j]); END; (* j *) + FOR j:=i+1 TO k DO BEGIN + c:=c+ABS(a[j,i]); r:=r+ABS(a[i,j]); END; (* j *) + g:=r/b; f:=1; s:=c+r; + + 40: IF c=g THEN BEGIN + f:=f/b; c:=c/b2; GOTO 50; END; + + (* the preceding four lines may be replaced by a machine *) + (* language procedure computing the exponent sig such *) + (* that sqrt(r/(c*b))<=b^sigi THEN FOR j:=1 TO m DO BEGIN + s:=z[i,j]; z[i,j]:=z[k,j]; z[k,j]:=s; + END; (* j *) + END; (* i *) + FOR i:=hi+1 TO n DO BEGIN + k:=ROUND(d[i]); + IF k<>i THEN FOR j:=1 TO m DO BEGIN + s:=z[i,j]; z[i,j]:=z[k,j]; z[k,j]:=s; + END; (* j *) + END; (* i *) + END; (* balbak *) + + +PROCEDURE elmhes(n,k,l: INTEGER; VAR a: glnpbynp; VAR int: glindx); + + VAR + i,j,la,m: INTEGER; + x,y: LONGREAL; + + BEGIN + la:= l-1; + FOR m:=k+1 TO la DO BEGIN + i:=m; x:= 0.0; + FOR j:=m TO l DO + IF ABS(a[j,m-1])>ABS(x) THEN BEGIN + x:=a[j,m-1]; i:= j; END; + int[m]:=i; + IF i<>m THEN BEGIN (* interchange rows and columns of array a *) + FOR j:=m-1 TO n DO BEGIN + y:= a[i,j]; a[i,j]:= a[m,j]; a[m,j]:= y; END; + FOR j:=1 TO l DO BEGIN + y:=a[j,i]; a[j,i]:=a[j,m]; a[j,m]:=y; END; + END; (* interchange *) + IF x<>0.0 THEN + FOR i:=m+1 TO l DO BEGIN + y:=a[i,m-1]; + IF y<>0.0 THEN BEGIN + a[i,m-1]:=y/x; y:=y/x; + FOR j:=m TO n DO a[i,j]:= a[i,j]-y*a[m,j]; + FOR j:=1 TO l DO a[j,m]:= a[j,m]+y*a[j,i]; + END; (* y<>0.0 *) + END; (* i *) + END; (* m *) + END; (* elmhes *) + +PROCEDURE elmtrans(n,low,upp:INTEGER; h:glnpbynp; int:glindx; + VAR v:glnpbynp); + + VAR + i,j,k: INTEGER; + + BEGIN + FOR i:=1 TO n DO BEGIN + FOR j:=1 TO n DO v[i,j]:= 0.0; v[i,i]:= 1.0; END; + FOR i:=upp-1 DOWNTO low+1 DO BEGIN + j:=int[i]; + FOR k:=i+1 TO upp DO v[k,i]:=h[k,i-1]; + IF i<>j THEN BEGIN + FOR k:=i TO upp DO BEGIN + v[i,k]:= v[j,k]; v[j,k]:=0.0; + END; (* k *) + v[j,i]:= 1.0; + END; (* i<>j *) + END; (* i *) + END; (* elmtrans *) + + +PROCEDURE hqr2(n,low,upp,maxits:INTEGER;macheps:LONGREAL; + eigveccalc: BOOLEAN; + VAR h,vecs:glnpbynp;VAR wr,wi:glnarray; + VAR cnt:glindx;VAR fail:BOOLEAN); + + LABEL + 10,20,31,32,33,40,50,60,70; + + VAR + i,j,k,l,m,na,its,en: INTEGER; + p,q,r,s,t,w,x,y,z,ra,sa,vr,vi,norm: LONGREAL; + notlast: BOOLEAN; + c1,c2,c3: fcomplex; + + BEGIN + fail:=FALSE; + FOR i:=1 TO low-1 DO BEGIN + wr[i]:=h[i,i]; wi[i]:=0.0; cnt[i]:=0; END; (* isolated roots *) + FOR i:=upp+1 TO n DO BEGIN + wr[i]:=h[i,i]; wi[i]:=0.0; cnt[i]:=0; END; (* isolated roots *) + en:=upp; t:=0.0; + + 10: + IF enna); + IF k<>m THEN BEGIN + p:=h[k,k-1]; q:=h[k+1,k-1]; + IF notlast THEN r:=h[k+2,k-1] ELSE r:= 0; + x:=ABS(p)+ABS(q)+ABS(r); IF x=0 THEN GOTO 33; + p:=p/x; q:=q/x; r:=r/x; + END; + s:= SQRT(p*p+q*q+r*r); + IF p<0 THEN s:=-s; + IF k<>m THEN h[k,k-1]:=-s*x + ELSE IF l<>m THEN h[k,k-1]:= -h[k,k-1]; + p:=p+s; x:=p/s; y:=q/s; z:=r/s; q:=q/p; r:=r/p; + + (* row modification *) + FOR j:=k TO n DO BEGIN + p:=h[k,j]+q*h[k+1,j]; + IF notlast THEN BEGIN + p:=p+r*h[k+2,j]; h[k+2,j]:=h[k+2,j]-p*z; END; + h[k+1,j]:=h[k+1,j]-p*y; h[k,j]:=h[k,j]-p*x; + END; (* j *) + IF k+30 THEN BEGIN (* real pair *) + IF p<0.0 THEN z:=p-z ELSE z:=p+z; + wr[na]:=x+z; s:=x-w/z; wr[en]:=s; wi[na]:=0.0; wi[en]:=0.0; + x:=h[en,na]; r:=SQRT(x*x+z*z); p:=x/r; q:=z/r; + FOR j:=na TO n DO BEGIN + z:=h[na,j]; h[na,j]:=q*z+p*h[en,j]; + h[en,j]:=q*h[en,j]-p*z; + END; (* row modification *) + FOR i:=1 TO en DO BEGIN + z:=h[i,na]; h[i,na]:=q*z+p*h[i,en]; + h[i,en]:=q*h[i,en]-p*z; + END; (* column modification *) + FOR i:=low TO upp DO BEGIN + z:=vecs[i,na]; vecs[i,na]:=q*z+p*vecs[i,en]; + vecs[i,en]:=q*vecs[i,en]-p*z; + END; (* accumulate *) + END (* pair of real roots *) + ELSE BEGIN (* complex pair *) + wr[na]:=x+p; wr[en]:=x+p; wi[na]:=z; wi[en]:=-z; + END; (* two roots found *) + en:= en-2; GOTO 10; + + +(* all roots found, now backsubstitute *) + +60: + IF NOT eigveccalc THEN GOTO 70; + norm:=0.0; k:=1; + FOR i:=1 TO n DO BEGIN + FOR j:=k TO n DO norm:=norm+ABS(h[i,j]); + k:=i; END; (* norm *) + + (* backsubstitution *) + FOR en:=n DOWNTO 1 DO BEGIN + p:=wr[en]; q:=wi[en]; na:=en-1; + IF q=0.0 THEN BEGIN (* real vector *) + m:=en; h[en,en]:=1.0; + FOR i:=na DOWNTO 1 DO BEGIN + w:=h[i,i]-p; r:=h[i,en]; + FOR j:=m TO na DO r:=r+h[i,j]*h[j,en]; + IF wi[i]<0.0 THEN BEGIN + z:=w; s:=r; END + ELSE BEGIN + m:=i; + IF wi[i]=0.0 THEN + IF w<>0.0 THEN h[i,en]:=-r/w ELSE h[i,en]:=-r/macheps/norm + ELSE BEGIN + (* solve w*h[i,en]+x*h[i+1,en]=-r *) + (* y*h[i,en]+z*h[i+1,en]=-s *) + x:=h[i,i+1]; y:=h[i+1,i]; + q:=SQR(wr[i]-p)+wi[i]*wi[i]; + t:=(x*s-z*r)/q; h[i,en]:=t; + IF ABS(x)>ABS(z) THEN h[i+1,en]:=(-r-w*t)/x + ELSE h[i+1,en]:=(-s-y*t)/z; + END; (* wi[i]>0.0 *) + END; (* wi[i]>=0.0 *) + END; (* i *) + END (* real vector *) + ELSE + IF q<0.0 THEN BEGIN (* complex vector associated with lambda=p-i*q *) + m:=na; + IF ABS(h[en,na])>ABS(h[na,en]) THEN BEGIN + h[na,na]:=-(h[en,en]-p)/h[en,na]; + h[na,en]:=-q/h[en,na]; + END + ELSE BEGIN + Complex(-h[na,en],0.0,c1); Complex(h[na,na]-p,q,c2); + Cdiv(c1,c2,c3); h[na,na]:= c3.re; h[na,en]:= c3.im; + END; + h[en,na]:=1.0; h[en,en]:=0.0; + FOR i:=na-1 DOWNTO 1 DO BEGIN + w:=h[i,i]-p; ra:=h[i,en]; sa:=0.0; + FOR j:=m TO na DO BEGIN + ra:=ra+h[i,j]*h[j,na]; + sa:=sa+h[i,j]*h[j,en]; + END; + IF wi[i]<0.0 THEN BEGIN + z:=w; r:=ra; s:=sa; + END + ELSE BEGIN + m:=i; + IF wi[i]=0.0 THEN BEGIN + Complex(-ra,-sa,c1); Complex(w,q,c2); + Cdiv(c1,c2,c3); h[i,na]:= c3.re; h[i,en]:= c3.im; + END + ELSE BEGIN + (* solve complex equations see page 387 *) + x:=h[i,i+1]; y:=h[i+1,i]; + vr:=SQR(wr[i]-p)+wi[i]*wi[i]-q*q; + vi:=(wr[i]-p)*2.0*q; + IF (vr=0.0) AND (vi=0.0) + THEN vr:=macheps*norm*(ABS(w)+ABS(q)+ABS(x)+ABS(y)+ABS(z)); + Complex(x*r-z*ra+q*sa,x*s-z*sa-q*ra,c1);Complex(vr,vi,c2); + Cdiv(c1,c2,c3); h[i,na]:= c3.re; h[i,en]:= c3.im; + IF ABS(x)>ABS(z)+ABS(q) THEN BEGIN + h[i+1,na]:=(-ra-w*h[i,na]+q*h[i,en])/x; + h[i+1,en]:=(-sa-w*h[i,en]-q*h[i,na])/x; + END + ELSE BEGIN + Complex(-r-y*h[i,na],-s-y*h[i,en],c1); Complex(z,q,c2); + Cdiv(c1,c2,c3); h[i+1,na]:= c3.re; h[i+1,en]:= c3.im; + END; + END; (* wi[i]>0.0 *) + END; (* wi[i]>=0.0 *) + END; (* i *) + END; (* complex vector *) + END; (* backsubstitution *) + + (* vectors of isolated roots *) + FOR i:=1 TO low-1 DO + FOR j:=i+1 TO n DO vecs[i,j]:=h[i,j]; + FOR i:=upp+1 TO n DO + FOR j:=i+1 TO n DO vecs[i,j]:=h[i,j]; + + (* multiply by transformation matrix to give *) + (* vectors of original full matrix *) + FOR j:=n DOWNTO low DO BEGIN + IF j<=upp THEN m:=j ELSE m:=upp; l:=j-1; + IF wi[j]<0.0 THEN BEGIN + FOR i:=low TO upp DO BEGIN + z:=0.0; y:=z; + FOR k:=low TO m DO BEGIN + y:=y+vecs[i,k]*h[k,l]; z:=z+vecs[i,k]*h[k,j]; + END; + vecs[i,l]:=y; vecs[i,j]:=z; + END; (* i *) + END (* wi[j]<0.0 *) + ELSE IF wi[j]=0.0 THEN + FOR i:=low TO upp DO BEGIN + z:=0.0; + FOR k:=low TO m DO z:=z+vecs[i,k]*h[k,j]; + vecs[i,j]:=z; + END; (* i *) + END; (* j *) + +70: +END; (* hqr2 *) + + +PROCEDURE hqr2alg(n,ref: INTEGER; VAR A,T: glnpbynp; VAR tmx:INTEGER; + epshqr2: LONGREAL; result,eigveccalc,fixedref: BOOLEAN); + + + VAR + wr,wi,bald:glnarray; + i,j,ballow,balhi:INTEGER; + intout: glindx; + fail,left,right: BOOLEAN; + + BEGIN + balance(n,10,A,ballow,balhi,bald); + elmhes(n,ballow,balhi,A,intout); + elmtrans(n,ballow,balhi,A,intout,T); + tmx:= maxithqr2; + hqr2(n,ballow,balhi,tmx,epshqr2,eigveccalc,A,T,wr,wi,intout,fail); + IF fail THEN alarm(0,'hqr2alg: fail in hqr2 alg.'); + tmx:= 0; + FOR i:=1 TO n DO IF ABS(intout[i])>tmx THEN tmx:=ABS(intout[i]); + FOR i:=1 TO n DO + FOR j:=1 TO n DO A[i,j]:=0.0; + i:=1; + REPEAT + IF wi[i]<>0.0 THEN BEGIN + A[i,i]:=wr[i]; A[i+1,i+1]:=wr[i]; + A[i,i+1]:=wi[i]; A[i+1,i]:=wi[i+1]; + i:=i+2; + END + ELSE BEGIN + A[i,i]:=wr[i]; A[i,i+1]:=wi[i]; A[i+1,i]:=wi[i]; + i:=i+1; + END; + UNTIL (i>=n); + IF i=n THEN A[i,i]:= wr[i]; + ombytning(n,A,T); + IF eigveccalc THEN BEGIN + balbak(n,ballow,balhi,n,T,bald); + normalizingmatrix(n,A,fixedref,ref,T); + END; + left:=false; + right:=false; + IF result THEN + FOR i:=1 TO n DO BEGIN + IF NOT(right) AND (iepsblk) + AND (ABS(A[i,i]-A[i+1,i+1])<=epsblk); + IF right THEN A[i,1]:=A[i-1,1] ELSE A[i,1]:=A[i,i]; + IF left THEN A[i,2]:=A[i,i+1] + ELSE IF right THEN A[i,2]:=-A[i-1,2] ELSE A[i,2]:=0; + right:=left; + left:=false; + END; + END; (* hqr2alg *) diff --git a/DPHF/hfscr b/DPHF/hfscr new file mode 100755 index 0000000..4f3b2ba --- /dev/null +++ b/DPHF/hfscr @@ -0,0 +1 @@ +pc kcm5dphf.p kinhp.o -lcurses diff --git a/DPHF/kcm5const.p b/DPHF/kcm5const.p new file mode 100644 index 0000000..243e71e --- /dev/null +++ b/DPHF/kcm5const.p @@ -0,0 +1,24 @@ +(****************************************************** + WARNING: This file was generated by kc v1.05 + CopyWrong 1994 by Kenneth Geisshirt. + Fri Sep 15 00:00:15 1995 +*******************************************************) +CONST +n=6; +np=6; +VAR +HBrO2:LONGREAL; +P:LONGREAL; +Br_m:LONGREAL; +CeIV:LONGREAL; +HBrO:LONGREAL; +BrO2:LONGREAL; +BrMA:LONGREAL; +BrO3_m:LONGREAL; +H_p:LONGREAL; +H2O:LONGREAL; +CeIII:LONGREAL; +MA:LONGREAL; +j0:LONGREAL; +kf6:LONGREAL; +species : ARRAY[1..n] OF STRING[20]; diff --git a/DPHF/kcm5dphf.p b/DPHF/kcm5dphf.p new file mode 100644 index 0000000..d789989 --- /dev/null +++ b/DPHF/kcm5dphf.p @@ -0,0 +1,20 @@ +(* New HP435 Pascal Version of Derpar and Hopf continuation + program. Version containing both the derpar-algorithm + and the Hopf-bifurcation calculation. Version 25/10 1994 *) + + +PROGRAM kcm5dphf(INPUT, OUTPUT); + + IMPORT + ARG; + + $include 'kcm5const.p'$ + $include 'dphf.def'$ + $include 'kcm5proc.p'$ + $include 'dphf.proc'$ + + BEGIN + detnumparam; + IF (numparam=1) THEN sp_derpar_driver + ELSE IF (numparam=2) THEN hf_derpar_driver; + END. diff --git a/DPHF/kcm5proc.p b/DPHF/kcm5proc.p new file mode 100644 index 0000000..6c4c5be --- /dev/null +++ b/DPHF/kcm5proc.p @@ -0,0 +1,465 @@ +(****************************************************** + WARNING: This file was generated by kc v1.05 + CopyWrong 1994 by Kenneth Geisshirt. + Fri Sep 15 00:00:15 1995 +*******************************************************) +PROCEDURE djacobian(xx_:glnarray; VAR dS_:gldjacobian); +BEGIN +HBrO2:=xx_[1]; +Br_m:=xx_[2]; +CeIV:=xx_[3]; +HBrO:=xx_[4]; +BrO2:=xx_[5]; +BrMA:=xx_[6]; +dS_[1,1,1]:=-1.200000e+04; +dS_[1,1,2]:=-2.000000e+06; +dS_[1,1,3]:=-7.000000e+03; +dS_[1,1,4]:=0.000000e+00; +dS_[1,1,5]:=0.000000e+00; +dS_[1,1,6]:=0.000000e+00; +dS_[1,2,1]:=-2.000000e+06; +dS_[1,2,2]:=0.000000e+00; +dS_[1,2,3]:=0.000000e+00; +dS_[1,2,4]:=0.000000e+00; +dS_[1,2,5]:=0.000000e+00; +dS_[1,2,6]:=0.000000e+00; +dS_[1,3,1]:=-7.000000e+03; +dS_[1,3,2]:=0.000000e+00; +dS_[1,3,3]:=0.000000e+00; +dS_[1,3,4]:=0.000000e+00; +dS_[1,3,5]:=-6.200000e+04; +dS_[1,3,6]:=0.000000e+00; +dS_[1,4,1]:=0.000000e+00; +dS_[1,4,2]:=0.000000e+00; +dS_[1,4,3]:=0.000000e+00; +dS_[1,4,4]:=0.000000e+00; +dS_[1,4,5]:=0.000000e+00; +dS_[1,4,6]:=0.000000e+00; +dS_[1,5,1]:=0.000000e+00; +dS_[1,5,2]:=0.000000e+00; +dS_[1,5,3]:=-6.200000e+04; +dS_[1,5,4]:=0.000000e+00; +dS_[1,5,5]:=7.770000e+07; +dS_[1,5,6]:=0.000000e+00; +dS_[1,6,1]:=0.000000e+00; +dS_[1,6,2]:=0.000000e+00; +dS_[1,6,3]:=0.000000e+00; +dS_[1,6,4]:=0.000000e+00; +dS_[1,6,5]:=0.000000e+00; +dS_[1,6,6]:=0.000000e+00; +dS_[2,1,1]:=0.000000e+00; +dS_[2,1,2]:=-2.000000e+06; +dS_[2,1,3]:=0.000000e+00; +dS_[2,1,4]:=0.000000e+00; +dS_[2,1,5]:=0.000000e+00; +dS_[2,1,6]:=0.000000e+00; +dS_[2,2,1]:=-2.000000e+06; +dS_[2,2,2]:=0.000000e+00; +dS_[2,2,3]:=0.000000e+00; +dS_[2,2,4]:=0.000000e+00; +dS_[2,2,5]:=0.000000e+00; +dS_[2,2,6]:=0.000000e+00; +dS_[2,3,1]:=0.000000e+00; +dS_[2,3,2]:=0.000000e+00; +dS_[2,3,3]:=0.000000e+00; +dS_[2,3,4]:=0.000000e+00; +dS_[2,3,5]:=0.000000e+00; +dS_[2,3,6]:=3.000000e+01; +dS_[2,4,1]:=0.000000e+00; +dS_[2,4,2]:=0.000000e+00; +dS_[2,4,3]:=0.000000e+00; +dS_[2,4,4]:=0.000000e+00; +dS_[2,4,5]:=0.000000e+00; +dS_[2,4,6]:=0.000000e+00; +dS_[2,5,1]:=0.000000e+00; +dS_[2,5,2]:=0.000000e+00; +dS_[2,5,3]:=0.000000e+00; +dS_[2,5,4]:=0.000000e+00; +dS_[2,5,5]:=0.000000e+00; +dS_[2,5,6]:=0.000000e+00; +dS_[2,6,1]:=0.000000e+00; +dS_[2,6,2]:=0.000000e+00; +dS_[2,6,3]:=3.000000e+01; +dS_[2,6,4]:=0.000000e+00; +dS_[2,6,5]:=0.000000e+00; +dS_[2,6,6]:=0.000000e+00; +dS_[3,1,1]:=0.000000e+00; +dS_[3,1,2]:=0.000000e+00; +dS_[3,1,3]:=-7.000000e+03; +dS_[3,1,4]:=0.000000e+00; +dS_[3,1,5]:=0.000000e+00; +dS_[3,1,6]:=0.000000e+00; +dS_[3,2,1]:=0.000000e+00; +dS_[3,2,2]:=0.000000e+00; +dS_[3,2,3]:=0.000000e+00; +dS_[3,2,4]:=0.000000e+00; +dS_[3,2,5]:=0.000000e+00; +dS_[3,2,6]:=0.000000e+00; +dS_[3,3,1]:=-7.000000e+03; +dS_[3,3,2]:=0.000000e+00; +dS_[3,3,3]:=0.000000e+00; +dS_[3,3,4]:=0.000000e+00; +dS_[3,3,5]:=-6.200000e+04; +dS_[3,3,6]:=-3.000000e+01; +dS_[3,4,1]:=0.000000e+00; +dS_[3,4,2]:=0.000000e+00; +dS_[3,4,3]:=0.000000e+00; +dS_[3,4,4]:=0.000000e+00; +dS_[3,4,5]:=0.000000e+00; +dS_[3,4,6]:=0.000000e+00; +dS_[3,5,1]:=0.000000e+00; +dS_[3,5,2]:=0.000000e+00; +dS_[3,5,3]:=-6.200000e+04; +dS_[3,5,4]:=0.000000e+00; +dS_[3,5,5]:=0.000000e+00; +dS_[3,5,6]:=0.000000e+00; +dS_[3,6,1]:=0.000000e+00; +dS_[3,6,2]:=0.000000e+00; +dS_[3,6,3]:=-3.000000e+01; +dS_[3,6,4]:=0.000000e+00; +dS_[3,6,5]:=0.000000e+00; +dS_[3,6,6]:=0.000000e+00; +dS_[4,1,1]:=6.000000e+03; +dS_[4,1,2]:=4.000000e+06; +dS_[4,1,3]:=0.000000e+00; +dS_[4,1,4]:=0.000000e+00; +dS_[4,1,5]:=0.000000e+00; +dS_[4,1,6]:=0.000000e+00; +dS_[4,2,1]:=4.000000e+06; +dS_[4,2,2]:=0.000000e+00; +dS_[4,2,3]:=0.000000e+00; +dS_[4,2,4]:=0.000000e+00; +dS_[4,2,5]:=0.000000e+00; +dS_[4,2,6]:=0.000000e+00; +dS_[4,3,1]:=0.000000e+00; +dS_[4,3,2]:=0.000000e+00; +dS_[4,3,3]:=0.000000e+00; +dS_[4,3,4]:=0.000000e+00; +dS_[4,3,5]:=0.000000e+00; +dS_[4,3,6]:=0.000000e+00; +dS_[4,4,1]:=0.000000e+00; +dS_[4,4,2]:=0.000000e+00; +dS_[4,4,3]:=0.000000e+00; +dS_[4,4,4]:=0.000000e+00; +dS_[4,4,5]:=0.000000e+00; +dS_[4,4,6]:=0.000000e+00; +dS_[4,5,1]:=0.000000e+00; +dS_[4,5,2]:=0.000000e+00; +dS_[4,5,3]:=0.000000e+00; +dS_[4,5,4]:=0.000000e+00; +dS_[4,5,5]:=0.000000e+00; +dS_[4,5,6]:=0.000000e+00; +dS_[4,6,1]:=0.000000e+00; +dS_[4,6,2]:=0.000000e+00; +dS_[4,6,3]:=0.000000e+00; +dS_[4,6,4]:=0.000000e+00; +dS_[4,6,5]:=0.000000e+00; +dS_[4,6,6]:=0.000000e+00; +dS_[5,1,1]:=0.000000e+00; +dS_[5,1,2]:=0.000000e+00; +dS_[5,1,3]:=7.000000e+03; +dS_[5,1,4]:=0.000000e+00; +dS_[5,1,5]:=0.000000e+00; +dS_[5,1,6]:=0.000000e+00; +dS_[5,2,1]:=0.000000e+00; +dS_[5,2,2]:=0.000000e+00; +dS_[5,2,3]:=0.000000e+00; +dS_[5,2,4]:=0.000000e+00; +dS_[5,2,5]:=0.000000e+00; +dS_[5,2,6]:=0.000000e+00; +dS_[5,3,1]:=7.000000e+03; +dS_[5,3,2]:=0.000000e+00; +dS_[5,3,3]:=0.000000e+00; +dS_[5,3,4]:=0.000000e+00; +dS_[5,3,5]:=6.200000e+04; +dS_[5,3,6]:=0.000000e+00; +dS_[5,4,1]:=0.000000e+00; +dS_[5,4,2]:=0.000000e+00; +dS_[5,4,3]:=0.000000e+00; +dS_[5,4,4]:=0.000000e+00; +dS_[5,4,5]:=0.000000e+00; +dS_[5,4,6]:=0.000000e+00; +dS_[5,5,1]:=0.000000e+00; +dS_[5,5,2]:=0.000000e+00; +dS_[5,5,3]:=6.200000e+04; +dS_[5,5,4]:=0.000000e+00; +dS_[5,5,5]:=-1.554000e+08; +dS_[5,5,6]:=0.000000e+00; +dS_[5,6,1]:=0.000000e+00; +dS_[5,6,2]:=0.000000e+00; +dS_[5,6,3]:=0.000000e+00; +dS_[5,6,4]:=0.000000e+00; +dS_[5,6,5]:=0.000000e+00; +dS_[5,6,6]:=0.000000e+00; +dS_[6,1,1]:=0.000000e+00; +dS_[6,1,2]:=0.000000e+00; +dS_[6,1,3]:=0.000000e+00; +dS_[6,1,4]:=0.000000e+00; +dS_[6,1,5]:=0.000000e+00; +dS_[6,1,6]:=0.000000e+00; +dS_[6,2,1]:=0.000000e+00; +dS_[6,2,2]:=0.000000e+00; +dS_[6,2,3]:=0.000000e+00; +dS_[6,2,4]:=0.000000e+00; +dS_[6,2,5]:=0.000000e+00; +dS_[6,2,6]:=0.000000e+00; +dS_[6,3,1]:=0.000000e+00; +dS_[6,3,2]:=0.000000e+00; +dS_[6,3,3]:=0.000000e+00; +dS_[6,3,4]:=0.000000e+00; +dS_[6,3,5]:=0.000000e+00; +dS_[6,3,6]:=-3.000000e+01; +dS_[6,4,1]:=0.000000e+00; +dS_[6,4,2]:=0.000000e+00; +dS_[6,4,3]:=0.000000e+00; +dS_[6,4,4]:=0.000000e+00; +dS_[6,4,5]:=0.000000e+00; +dS_[6,4,6]:=0.000000e+00; +dS_[6,5,1]:=0.000000e+00; +dS_[6,5,2]:=0.000000e+00; +dS_[6,5,3]:=0.000000e+00; +dS_[6,5,4]:=0.000000e+00; +dS_[6,5,5]:=0.000000e+00; +dS_[6,5,6]:=0.000000e+00; +dS_[6,6,1]:=0.000000e+00; +dS_[6,6,2]:=0.000000e+00; +dS_[6,6,3]:=-3.000000e+01; +dS_[6,6,4]:=0.000000e+00; +dS_[6,6,5]:=0.000000e+00; +dS_[6,6,6]:=0.000000e+00; +END; (* djacobian *) + +PROCEDURE ddjacobian(xx_:glnarray;VAR ddS_:glddjacobian); +BEGIN +END; (* ddjacobian *) + +PROCEDURE derivs(bj_:BOOLEAN; xx_:glnarray; t_:LONGREAL; + VAR vv_:glnarray; VAR jj_:glnpbynp); +BEGIN +HBrO2:=xx_[1]; +Br_m:=xx_[2]; +CeIV:=xx_[3]; +HBrO:=xx_[4]; +BrO2:=xx_[5]; +BrMA:=xx_[6]; +P:=(0); +BrO3_m:=(1.200000e-02); +H_p:=(1); +H2O:=(5.550000e+01); +CeIII:=((8.600000e-05)-CeIV); +MA:=(1.670000e-01); +vv_[1]:=(((((((-1)*(j0*HBrO2))+((2.400000e-02)*Br_m))+((-1) +*(((2000000)*HBrO2)*Br_m)))+((-1)*(((3.960000e-01)*HBrO2)-(((700000) +*(BrO2*BrO2))*(5.550000e+01)))))+((((62000)*BrO2)*((8.600000e-05) +-CeIV))-(((7000)*HBrO2)*CeIV)))+((-2)*((3000)*(HBrO2*HBrO2))) +); +vv_[2]:=(((((-1)*(j0*Br_m))+((-1)*((2.400000e-02)*Br_m) +))+((-1)*(((2000000)*HBrO2)*Br_m)))+(((30)*CeIV)*BrMA)); +vv_[3]:=(((((-1)*(j0*CeIV))+((((62000)*BrO2)*((8.600000e-05) +-CeIV))-(((7000)*HBrO2)*CeIV)))+((-1)*(((3.000000e-01)*CeIV +)*(1.670000e-01))))+((-1)*(((30)*CeIV)*BrMA))); +vv_[4]:=((((((-1)*(j0*HBrO))+((2.400000e-02)*Br_m))+((2) +*(((2000000)*HBrO2)*Br_m)))+((3000)*(HBrO2*HBrO2)))+((-1)*((kf6* +HBrO)*(1.670000e-01)))); +vv_[5]:=((((-1)*(j0*BrO2))+((2)*(((3.960000e-01)*HBrO2 +)-(((700000)*(BrO2*BrO2))*(5.550000e+01)))))+((-1)*((((62000)*BrO2 +)*((8.600000e-05)-CeIV))-(((7000)*HBrO2)*CeIV)))); +vv_[6]:=((((-1)*(j0*BrMA))+((kf6*HBrO)*(1.670000e-01)))+ +((-1)*(((30)*CeIV)*BrMA))); +IF bj_ THEN BEGIN +jj_[1, 1]:=((((((-1)*j0)+((-1)*((2000000)*Br_m)))+(-3.960000e-01) +)+(-(((7000)*CeIV))))+((-2)*((3000)*(HBrO2*(2))))); +jj_[1, 2]:=((2.400000e-02)+((-1)*((2000000)*HBrO2))); +jj_[1, 3]:=((((62000)*BrO2)*(-1))-((7000)*HBrO2)); +jj_[1, 5]:=(((-1)*(-((((700000)*(BrO2*(2)))*(5.550000e+01))))) ++((62000)*((8.600000e-05)-CeIV))); +jj_[2, 1]:=((-1)*((2000000)*Br_m)); +jj_[2, 2]:=((((-1)*j0)+(-2.400000e-02))+((-1)*((2000000)*HBrO2) +)); +jj_[2, 3]:=((30)*BrMA); +jj_[2, 6]:=((30)*CeIV); +jj_[3, 1]:=(-(((7000)*CeIV))); +jj_[3, 3]:=(((((-1)*j0)+((((62000)*BrO2)*(-1))-((7000)*HBrO2)) +)+(-5.010000e-02))+((-1)*((30)*BrMA))); +jj_[3, 5]:=((62000)*((8.600000e-05)-CeIV)); +jj_[3, 6]:=((-1)*((30)*CeIV)); +jj_[4, 1]:=(((2)*((2000000)*Br_m))+((3000)*(HBrO2*(2)))); +jj_[4, 2]:=((2.400000e-02)+((2)*((2000000)*HBrO2))); +jj_[4, 4]:=(((-1)*j0)+((-1)*(kf6*(1.670000e-01)))); +jj_[5, 1]:=((7.920000e-01)+((-1)*(-(((7000)*CeIV))))); +jj_[5, 3]:=((-1)*((((62000)*BrO2)*(-1))-((7000)*HBrO2))); +jj_[5, 5]:=((((-1)*j0)+((2)*(-((((700000)*(BrO2*(2)))*(5.550000e+01) +)))))+((-1)*((62000)*((8.600000e-05)-CeIV)))); +jj_[6, 3]:=((-1)*((30)*BrMA)); +jj_[6, 4]:=(kf6*(1.670000e-01)); +jj_[6, 6]:=(((-1)*j0)+((-1)*((30)*CeIV))); +END; +END; (* derivs *) + +PROCEDURE derivsinit; +BEGIN +species[1]:='HBrO2'; +species[2]:='Br_m'; +species[3]:='CeIV'; +species[4]:='HBrO'; +species[5]:='BrO2'; +species[6]:='BrMA'; +epsr:=1.000000e-04; +epsa:=1.000000e-20; +name_datafile:='burstdat1'; +xx[1]:=4.153821e-08; +xx[2]:=3.217686e-07; +xx[3]:=7.906439e-07; +xx[4]:=2.281131e-08; +xx[5]:=5.854012e-09; +xx[6]:=1.696279e-03; +jacobi[1, 4]:= 0.000000e+00; +jacobi[1, 6]:= 0.000000e+00; +jacobi[2, 4]:= 0.000000e+00; +jacobi[2, 5]:= 0.000000e+00; +jacobi[3, 2]:= 0.000000e+00; +jacobi[3, 4]:= 0.000000e+00; +jacobi[4, 3]:= 0.000000e+00; +jacobi[4, 5]:= 0.000000e+00; +jacobi[4, 6]:= 0.000000e+00; +jacobi[5, 2]:= 0.000000e+00; +jacobi[5, 4]:= 0.000000e+00; +jacobi[5, 6]:= 0.000000e+00; +jacobi[6, 1]:= 0.000000e+00; +jacobi[6, 2]:= 0.000000e+00; +jacobi[6, 5]:= 0.000000e+00; +END; (* derivs *) + +PROCEDURE sp_dalfa(bj_: BOOLEAN;xx_: glnarray; VAR gg_: glnpbynp); +BEGIN +END; (* sp_dalfa *) + +PROCEDURE derpinit; +BEGIN +END; (* derpinit *) + +PROCEDURE hf_dalfa(bj_,tp_: BOOLEAN;xx_: glnarray; VAR gg_: glnpbynp); +BEGIN +HBrO2:=xx_[1]; +Br_m:=xx_[2]; +CeIV:=xx_[3]; +HBrO:=xx_[4]; +BrO2:=xx_[5]; +BrMA:=xx_[6]; +IF tp_ THEN BEGIN +j0:=xx_[n1]; +kf6:=xx_[n2]; +IF bj_ THEN BEGIN +gg_[1, n1]:=((-1)*HBrO2); +gg_[2, n1]:=((-1)*Br_m); +gg_[3, n1]:=((-1)*CeIV); +gg_[4, n1]:=((-1)*HBrO); +gg_[5, n1]:=((-1)*BrO2); +gg_[6, n1]:=((-1)*BrMA); +END; +END +ELSE BEGIN +kf6:=xx_[n1]; +j0:=xx_[n2]; +IF bj_ THEN BEGIN +gg_[1, n1]:=(0); +gg_[2, n1]:=(0); +gg_[3, n1]:=(0); +gg_[4, n1]:=((-1)*(HBrO*(1.670000e-01))); +gg_[5, n1]:=(0); +gg_[6, n1]:=(HBrO*(1.670000e-01)); +END; +END; +END; (* hf_dalfa *) + +PROCEDURE hopfinit; +BEGIN +need_dd_jac:=FALSE; +maxoutn1:=30; +maxoutn2:=2; +cfout:=10; +ref:=3; +hopfbftp:=1; +re1:=5.000000e-01; +im1:=5.000000e-01; +maxnoofp:=10; +maxithqr2:=30; +maxitbisec:=30; +maxitintpol:=30; +maxititera:=30; +maxitcorrec:=30; +corrhreg:=10; +hh:=1.000000e+00; +epsfx:=1.000000e-15; +epsblk:=1.000000e-15; +epshqr2:=1.000000e-20; +epsbisecr:=1.000000e-10; +epsmach:=1.000000e-15; +epsdigit:=1.000000e-14; +print_on_screen:=1; +print_on_file:=1; +failure_print:=0; +para_regU:=1; +qc_calc:=0; +hf_calc:=1; +df_calc:=0; +hass_calc:=1; +kura_calc:=0; +eigvec_prn:=0; +name_datafile:= 'burstdat1'; +name_textfile:= 'burstdat1.t'; +xx[1]:=4.153821e-08; +initndir[1]:=-1; +inithmax[1]:=1.000000e+02; +initxupp[1]:=1.000000e+03; +initxlow[1]:=0.000000e+00; +initpref[1]:=1.000000e-01; +xx[2]:=3.217686e-07; +initndir[2]:=-1; +inithmax[2]:=1.000000e+02; +initxupp[2]:=1.000000e+03; +initxlow[2]:=0.000000e+00; +initpref[2]:=1.000000e-01; +xx[3]:=7.906439e-07; +initndir[3]:=-1; +inithmax[3]:=1.000000e+02; +initxupp[3]:=1.000000e+03; +initxlow[3]:=0.000000e+00; +initpref[3]:=1.000000e-01; +xx[4]:=2.281131e-08; +initndir[4]:=-1; +inithmax[4]:=1.000000e+02; +initxupp[4]:=1.000000e+03; +initxlow[4]:=0.000000e+00; +initpref[4]:=1.000000e-01; +xx[5]:=5.854012e-09; +initndir[5]:=-1; +inithmax[5]:=1.000000e+02; +initxupp[5]:=1.000000e+03; +initxlow[5]:=0.000000e+00; +initpref[5]:=1.000000e-01; +xx[6]:=1.696279e-03; +initndir[6]:=-1; +inithmax[6]:=1.000000e+02; +initxupp[6]:=1.000000e+03; +initxlow[6]:=0.000000e+00; +initpref[6]:=1.000000e-01; +xx[n1]:=8.500000e-05; +initndir[n1]:=1; +inithmax[n1]:=1.000000e-08; +initxlow[n1]:=0.000000e+00; +initxupp[n1]:=1.000000e+00; +initpref[n1]:=1.000000e-06; +xx[n2]:=8.200000e+00; +initndir[n2]:=-1; +inithmax[n2]:=1.000000e-02; +initxlow[n2]:=0.000000e+00; +initxupp[n2]:=1.000000e+02; +initpref[n2]:=1.000000e-04; +END; (* hopfinit *) + +PROCEDURE detnumparam; +BEGIN + numparam:=2; +END; (* detnumparam *) + diff --git a/DPHF/kinhp.c b/DPHF/kinhp.c new file mode 100644 index 0000000..36e9928 --- /dev/null +++ b/DPHF/kinhp.c @@ -0,0 +1,20 @@ +void init() +{ printf("\033h\033J"); +} + +void disp(n, t, h, q, x, xmax, xmin) +int n; +double t,h,q; +double x[],xmax[],xmin[]; +{ int i,row,col; + printf("\033\ht = %e",t); + printf(" h = %e",h); + printf(" q = %e",q); + printf("\n"); + for (i= 0; i P ; k> = j0; +102: ADP -> P ; k> = j0; +103: AMP -> P ; k> = j0; +104: NADH -> P ; k> = j0; +105: NAD -> P ; k> = j0; +106: GLC -> P ; k> = j0; +107: G6P -> P ; k> = j0; +108: F6P -> P ; k> = j0; +109: FBP -> P ; k> = j0; +110: XGAP -> P ; k> = j0; +111: PEP -> P ; k> = j0; +112: PYR -> P ; k> = j0; +113: G1P -> P ; k> = j0; +114: UTP -> P ; k> = j0; +115: UDP -> P ; k> = j0; + +/* In flow */ +201: ATPo -> ATP ; k> = j0; +202: ADPo -> ATP ; k> = j0; +203: AMPo -> ATP ; k> = j0; +204: NADHo -> NADH ; k> = j0; +205: NADo -> NAD ; k> = j0; +206: GLCo -> GLC ; k> = j0; +214: UTPo -> UTP ; k> = j0; +215: UDPo -> UDP ; k> = j0; + + + +/* Reactions */ +1: GLC + ATP -> G6P + ADP ; v>= V1m*([ATP]/([ATP]+K1ATP))*([GLC]/([GLC]+K1GLC)); + +2: G6P -> F6P ; v>= V2m*([G6P]-[F6P]/K2eq)/(K2G6P+[G6P]+(K2G6P/K2F6P)*[F6P]); + +3: ATP + F6P -> FBP + ADP ; v>=V3m*(([F6P]/K3F6P)*([F6P]/K3F6P+1.0)^3)/((L3*(([ATP]/K3ATP+1.0)/([AMP]/K3AMP+1.0))^4)+([F6P]/K3F6P+1.0)^4)*([ATP]/(K3mATP+[ATP])); + +4: FBP -> 2XGAP ; v>= V4m*([FBP]-[XGAP]/K4eq)/(K4FBP+[FBP]+[XGAP]*K4FBP/K4XGAP); + +5: XGAP + NAD -> PEP + NADH ; v>= V5m*([NAD]/([NAD]+K5NAD))*([XGAP]/([XGAP]+K5XGAP)); + +6: PEP + 2ADP -> PYR + 2ATP ; v>=V6m*(([PEP]/K6PEP)*([PEP]/K6PEP+1.0)^3)/((L6*(([ATP]/K6ATP+1.0)/([FBP]/K6FBP+1.0))^4)+([PEP]/K6PEP+1.0)^4)*([ADP]/(K6ADP+[ADP])); + +/* +6: PEP + 2ADP -> P + 2ATP; v>= V6m*([PEP]/(K6PEP+[PEP]))*([ADP]/([ADP]+K6ADP)); +*/ + +7: PYR + NADH -> P + NAD ; v>= V7m*[PYR]/(K7PYR+[PYR])*([NADH]/(K7NADH+[NADH])); + +8: G6P -> G1P ; v>= V8m*([G6P]-[G1P]/K8eq)/(K8G6P+[G6P]+(K8G6P/K8G1P*[G1P])); + +9: G1P + UTP -> UDP + P ; v>= V9m*[G1P]/(K9G1P+[G1P])*([UTP]/(K9UTP+[UTP])); + +10: AMP + ATP <-> 2ADP ; v>=V10mf*[ATP]/([ATP]+K10ATP)*[AMP]/([AMP]+K10AMP); v<=V10mr*([ADP]/([ADP]+K10ADP))^2; + +11: ATP -> ADP ; v>=V11m*[ATP]/([ATP]+K11ATP); + +12: UDP + ATP <-> UTP + ADP ; v>=V12mf*[ATP]/([ATP]+K12ATP)*[UDP]/([UDP]+K12UDP); v<=V12mr*([ADP]/([ADP]+K12ADP))*([UTP]/([UTP]+K12UTP)); + +[ATPo] = 3.5; +[ADPo] = 0.03; +[AMPo] = 0.01; +[GLCo] = 100.0; +[UTPo] = 0.2; +[UDPo] = 0.02; +[NADHo] = 0.50; +[NADo] = 1.0; + +[P] = 0.0; +/* +[ATP](0) = 1.75; +[ADP](0) = 0.15; +[AMP](0) = 0.05; +[UTP](0) = 0.1; +[GLC](0) = 0.0; +[NADH](0) = 0.25; +[NAD](0) = 0.5; +*/ + +/* +[ADP](0) = 7.546134e-02; +[AMP](0) = 2.263944e-02; + +[ATP](0) = 3.801461e+00; +[ADP](0) = 0.546134e-02; +[AMP](0) = 0.263944e-02; +[NADH](0) = 1.498375e+00; +[NAD](0) = 1.456075e-03; +[GLC](0) = 2.201209e-02; +[G6P](0) = 2.491330e+00; +[F6P](0) = 6.595394e-01; +[FBP](0) = 1.204481e+01; +[XGAP](0) = 6.970166e+01; +[PEP ](0) = 9.814520e-01; +[PYR](0) = 1.697947e-02; +[G1P](0) = 1.431899e-01; +[UTP](0) = 1.214918e-02; +[UDP](0) = 1.214918e-03; +*/ + +[ATP](0) = 3.471765e+00; +[ADP](0) = 7.549341e-02; +[AMP](0) = 6.162086e-03; +[NADH](0) =1.499080e+00; +[NAD](0) = 9.114976e-04; +[GLC](0) = 1.277779e-02; +[G6P](0) = 4.107067e+01; +[F6P](0) = 1.130958e+01; +[FBP](0) = 2.403232e+00; +[XGAP](0) =9.930902e+00; +[PEP ](0) =9.661628e-01; +[PYR](0) = 3.292006e-02; +[G1P](0) = 2.364712e+00; +[UTP](0) = 4.855524e-02; +[UDP](0) = 1.611570e-01; + diff --git a/DPHF/lu.proc b/DPHF/lu.proc new file mode 100644 index 0000000..ce0c88a --- /dev/null +++ b/DPHF/lu.proc @@ -0,0 +1,119 @@ + PROCEDURE ludcmp(VAR a: glnpbynp; n,np: integer; + VAR indx: glindx; VAR d: LONGREAL); + CONST + tiny=1.0e-20; + VAR + k,j,imax,i: integer; + sum,dum,big: LONGREAL; + vv: glnarray; + BEGIN + d := 1.0; + FOR i := 1 to n DO BEGIN + big := 0.0; + FOR j := 1 to n DO IF (abs(a[i,j]) > big) THEN big := abs(a[i,j]); + IF (big = 0.0) THEN BEGIN +writeln('ludcmp: ',i,j); +for j:=1 to n do writeln('test : a[i,j] : ',i,j,a[i,j]); + alarm(0,'LUDCMP - singular matrix'); + END; + vv[i] := 1.0/big + END; + FOR j := 1 to n DO BEGIN + IF (j > 1) THEN BEGIN + FOR i := 1 to j-1 DO BEGIN + sum := a[i,j]; + IF (i > 1) THEN BEGIN + FOR k := 1 to i-1 DO BEGIN + sum := sum-a[i,k]*a[k,j] + END; + a[i,j] := sum + END + END + END; + big := 0.0; + FOR i := j to n DO BEGIN + sum := a[i,j]; + IF (j > 1) THEN BEGIN + FOR k := 1 to j-1 DO BEGIN + sum := sum-a[i,k]*a[k,j] + END; + a[i,j] := sum + END; + dum := vv[i]*abs(sum); + IF (dum > big) THEN BEGIN + big := dum; + imax := i + END + END; + IF (j <> imax) THEN BEGIN + FOR k := 1 to n DO BEGIN + dum := a[imax,k]; + a[imax,k] := a[j,k]; + a[j,k] := dum + END; + d := -d; + vv[imax] := vv[j] + END; + indx[j] := imax; + IF (j <> n) THEN BEGIN + IF (a[j,j] = 0.0) THEN a[j,j] := tiny; + dum := 1.0/a[j,j]; + FOR i := j+1 to n DO BEGIN + a[i,j] := a[i,j]*dum + END + END + END; + IF (a[n,n] = 0.0) THEN a[n,n] := tiny + END; (* ludcmp *) + + PROCEDURE lubksb(a: glnpbynp; n,np: integer; indx: glindx; VAR b: glnarray); + VAR + j,ip,ii,i: integer; + sum: LONGREAL; + BEGIN + ii := 0; + FOR i := 1 to n DO BEGIN + ip := indx[i]; + sum := b[ip]; + b[ip] := b[i]; + IF (ii <> 0) THEN BEGIN + FOR j := ii to i-1 DO BEGIN + sum := sum-a[i,j]*b[j] + END + END ELSE IF (sum <> 0.0) THEN BEGIN + ii := i + END; + b[i] := sum + END; + FOR i := n DOWNTO 1 DO BEGIN + sum := b[i]; + IF (i < n) THEN BEGIN + FOR j := i+1 to n DO BEGIN + sum := sum-a[i,j]*b[j] + END + END; + b[i] := sum/a[i,i] + END + END; (* lubksb *) + + + PROCEDURE inversmatrix(n: INTEGER; P:glnpbynp; VAR IP: glnpbynp); + + VAR + i,j: INTEGER; + d: LONGREAL; + A: glnpbynp; + int: glindx; + evec,ekon: glnarray; + + BEGIN + A:= P; + FOR i:=1 TO n DO ekon[i]:=0.0; + ludcmp(A,n,n,int,d); + FOR i:=1 TO n DO + BEGIN + evec:= ekon; evec[i]:= 1.0; + lubksb(A,n,n,int,evec); + FOR j:=1 TO n DO IP[j,i]:= evec[j]; + END; + END; (* inversmat *) diff --git a/DPHF/quenchcal.proc b/DPHF/quenchcal.proc new file mode 100644 index 0000000..77ad118 --- /dev/null +++ b/DPHF/quenchcal.proc @@ -0,0 +1,72 @@ + FUNCTION argu(g,h: LONGREAL): LONGREAL; + CONST + PI = 3.141592654; + VAR + angle: LONGREAL; + + BEGIN + IF g<>0 THEN + BEGIN + angle:= ARCTAN(h/g); + IF g<0 THEN angle:= angle+PI; + IF angle>PI THEN angle:= angle-2*PI; + END + ELSE IF h>0 THEN angle:= PI/2 ELSE angle:= -PI/2; + argu:= 360/2/PI*angle; + END; (* argu *) + + FUNCTION radius(a,b: LONGREAL): LONGREAL; + + BEGIN + radius:= SQRT(SQR(a)+SQR(b)); + END; (* radius *) + + PROCEDURE compamppha(n: INTEGER; P: glnpbynp; + VAR amp,phase: glnarray); + + VAR + i: INTEGER; + u,v: glnarray; + + BEGIN + FOR i:=1 TO n DO + BEGIN + u[i]:= P[i,1]; + v[i]:= P[i,2]; + END; + FOR i:=1 TO n DO + BEGIN + amp[i]:= radius(u[i],v[i]); + phase[i]:= argu(u[i],v[i]); + END; + END; (* comamppha *) + + PROCEDURE stopdata(n,m: INTEGER; xx: glnarray; IP: glnpbynp; + VAR q,fi: glnarray; VAR qd,fid: LONGREAL); + + VAR + gd,hd: LONGREAL; + i: INTEGER; + g,h: glnarray; + + BEGIN + FOR i:=1 TO n DO + BEGIN + g[i]:= IP[1,i]; + h[i]:= IP[2,i]; + END; + FOR i:=1 TO n DO + BEGIN + q[i]:= 1/radius(g[i],h[i]); + fi[i]:= argu(-g[i],-h[i]); + END; + gd:= 0; hd:= 0; + FOR i:=1 TO n DO + BEGIN + gd:= gd+g[i]*xx[i]; + hd:= hd+h[i]*xx[i]; + END; + gd:= -gd; hd:= -hd; + qd:= -xx[m]/radius(gd,hd); + fid:= argu(-gd,-hd); + END; (* stopdata *) diff --git a/KnownBugs.md b/KnownBugs.md new file mode 100644 index 0000000..3bd4118 --- /dev/null +++ b/KnownBugs.md @@ -0,0 +1,2 @@ +# Known bugs + diff --git a/README.md b/README.md index f1e8e2a..91fdcf9 100644 --- a/README.md +++ b/README.md @@ -1,2 +1,213 @@ -# kc -Kinetic Compiler - simulation of chemical reactions +# kc - A Kinetic Compiler + +Source code, test files, and documentation in this repository go back +to mid-1990s. With only a few modifications, the files are left as +they were. The authors' addresses have been removed since they have +changed. Moreover, the license has changed from GNU General Public +License v2 to GNU General Public License v3. Furthermore this preamble +has been added. + +Recently (November 2020) the source code has been compiled on MacOS +v10.15 using GCC. + +The publication of kc has been a wish for some time. We hope it can be +useful to some, and asumement for others. + +## Introduction + +This is the README file for the kc project. The kc program is a +"kinetic compiler". This means it is able to transform chemical +equations into simulation programs. + +The motivation of the compiler and the use is documented in one of the +authors' master thesis (_Chemical waves in reaction-diffusion systems: +a numerical study_, K. Geisshirt, University of Copenhagen, May 1994). + +The newest edition of the user's manual can be founded in +`docs/kc-man.tex`, and the programmer's manual in `docs/kc.tex`. For +users who do not have LaTeX, please write to the author to obtain +either a hard-copy or a postscript version. + +In addition to the user's manual there exists a directory with +examples of input to kc. The directory is named `test` (some of our test +examples are found here). + +No program is bug free, and the known bugs in kc are documented in the +file `KnownBugs.md`. Furthermore, the program is not complete (which +program is?), and a list of future enchancement is found in the file +`TODO.md`. + + +## The history of kc +* April 1995: Version 1.05 released. A number of bugs were + discovered in version 1.0 and they have been fixed. Some + cleaning up has been done. + + This version was developed at KIKU and RUC. + +* December 1994: Version 1.00 released. The compiler is now running + very fine. It works very well together with a backend which is + solving ordinary differential equations. The following code + generators are supported in this version: + 1. Waves (dymanical simulations of reaction-diffusion systems). + 2. Eigen (computing various properties of a given system of ODEs). + 3. KNcont (continuation program written in Pascal). + 4. KCI (numerical solution of ODEs/dynamical simulation of + homogenous chemical reactions). + +* July 1994: Version 0.99 released (only for internal use). A number + of bugs have been fixed. A solver of ordinary differential + equations called KGode has been developed. The solver is written in + ANSI C and have been ported to at least to four platforms: HP-UX, + ConvexOS, Linux, and MS-DOS. There exists an automatic steplength + controller. The solver implements three numerical schemes: + 1. 4th order Runge-Kutta [1]. + 2. Calahan's method [2]. + 3. Generalised Runge-Kutta [1, 3]. + + Various modes have been developed and old ones have been extended. + But in total, the following modes are supported now: + 1. Kin (dynamical simulations - requires a Pascal compiler). + 2. Waves (dynamical simulations of reaction-diffusion systems, + simulation programs written by K. Geisshirt). + 3. KNcont (continuations - require a Pascal compiler). + 4. Eigen (calculation of eigenvalues and -vectors of the Jacobian + matrix). + 5. KGode (dynamical simulations). + 6. Stoc (dynamical simulations using a stochastic approach [5]). + 7. IScont (also called CONT - a continuation package in + Fortran-77). + + The grammar has been extended a little so now it is possible of + read and store string constants. The grammar for expressions has + been modified a bit in order to fix a major bug. + + This version has been developed at KIKU. + +* December 1993: Version 0.50 released. It mainly fixes of a number of bugs. + +* September 1993: Version 0.25 released. Only the following modes are + supported in this version: + 1. Kin + 2. Waves + 3. KNcont + 4. Eigen + Other modes in previous versions were never used, and therefore the + author stopped supporting them. + + A lot of cleaning up has been done. K. Nielsen has done a lot of + testing, which has discovered many minor bugs and some major ones. + These errors had been corrected. + +* May 1993: Version 0.20 released. Autocatalytic reactions can be + used, and the code generators are supporting parameters. Bugs in + version 0.10 have been corrected. This version is developed at KIKU + in Copenhagen. The grammar is changed, so the following features + are supported: + 1. parameters + + The following code generators have been added: + 1. Waves (A PDE solver by O. Jensen et al.). + 2. Keld Nielsen's continuation program (KNcont). + 3. A mode which calculates the Jacoby matrix, its eigenvalues and + eigenvectors. + + The code generator to CONT is now full operative, i.e. it supports + the use of parameters. + +* October 1992: Version 0.10 released. This version supports KIN, + CONT, and Dalimil Snita's Chemical Meta Language. This version is + developed at KIKU in Copenhagen. The grammar is now supporting + 1. ordinary differential equations + 2. constraints + + The program is now not using so much memory as previous version. + +* September 1992: Version 0.00 released. This version only supports + KIN and CONT. This version is the initial guess of the system. It + was developed at VSCHT in Prague. + + +## Installation and running + +The installation is very easy! There exists a small script called +kc-inst which does most of the job. The script must be supplied with +two arguments, namely a directory name and a platform. The directory +name is a prefix to the directories which you want kc to "live". The +platform is at the moment one of the following: + +* Generic GNU C-compiler +* Linux +* DECstations running Ultrix +* Silicon Graphics +* Convex running ConvexOS +* HP-UX v7 +* IBM RS/6000 running AIX v3.2 + +Run the script with no arguments and you will get some help. The +script will generate a script called kci, which is a front-end to the +kci-mode. + +An example: If you want to install the system on a Linux machine +in the directories /usr/local you should type: + +```sh +kc-inst /usr/local LINUX +``` + +In order to use the DOS version, you have to have an Intel 80386 (or +higher) computer. You also have to install the djgpp package, and this +package is surposed to be used during all your simulations. The +makefile you should used is `src/Makefile.DOS`, and the file +`Scripts/kci.bat` is a front-end to the `kci-mode`. + +There can be a problem with newer Unices, because they have support +for your natioonal language. Therefore, check the enviroment variable +called `LANG` to see if it is set to `C`. + +Another thing is that you should create a new directories before +installing. Let us assume you want to use the directory `DIR` as prefix +(as mentioned above). You should them create the directories `DIR/num` +and `DIR/bin`. + +## Legal issues + +The program is copyrighted in the sense of GNU General Public License +v3. The authors cannot be responsible for any looses the programs in +this package may produce. + +If the program is used to published scientific results, authors are +asked to make a footnote or better a reference to kc. A the moment the +best reference is [4], but this may change in the future. + +The package comes under the GNU General Public License v3 (GPLv3), and GPLv3 +is supplied in form of the file `LICENSE`. Please read this file. + + +## Support + +The program is NOT supported by the authors, but you are welcome to +create an issue. + + +## Acknowledgements + +The authors wish to thank the following people: + +* M. Marek - ideas to the first version. +* P.G. Sorensen - do. and advices. +* F. Hynne - same as P.G. Sorensen. +* and the first users (J. Wang, A. Nagy, etc.). + +## Abbreviations + +* VSCHT: Prague Institute for Chemical Engineering. +* KIKU: Institute of Chemistry, University of Copenhagen. +* KIN: KINetic compiler and simulator (by P.G. Sorensen). +* CONT: CONTinuation program (by I. Screiber). +* EIGEN: Mode calculating the jacoby matrix and its eigenvectors and eigenvalues. +* KNcont: Keld Nielsen's continuation programs. +* KGode: An ODE solver written by Keld Nielsen and Kenneth Geisshirt. +* Stoc: A dynamical simulator using a stochastic scheme. +* GPL: GNU General Public License. +* RUC: Roskilde University diff --git a/Scripts/RDrun b/Scripts/RDrun new file mode 100644 index 0000000..ce12456 --- /dev/null +++ b/Scripts/RDrun @@ -0,0 +1,8 @@ +kc -m2 < $1 +cc -Aa -o $1.exe -O RDadi2nf model.c -lm +kc -m2 < $1 +cc -Aa -O -o $1.exe RDadi2nf.c model.c -lm +nohup nice +19 $1.exe & +kc -m2 < $1 +cc -Aa -O -o $1.exe RDadi2nf.c model.c -lm +nohup nice +19 $1.exe adi2nf.ini $1 & diff --git a/Scripts/kci-test b/Scripts/kci-test new file mode 100755 index 0000000..87be209 --- /dev/null +++ b/Scripts/kci-test @@ -0,0 +1,12 @@ +cp /usr/users/kneth/num/kksolver.c . +cp /usr/users/kneth/num/matrix.o . +cp /usr/users/kneth/num/integr.o . +cp /usr/users/kneth/num/odesolv.o . +cp /usr/users/kneth/num/odeserv.o . +/usr/users/kneth/bin/kc -m3 -v < $1 +cc -O2 -w -Olimit 1000 -D_PLATFORM_ULTRIX_ -c -I. -I/usr/users/kneth/num -I- kksolver.c +cc -O2 -w -Olimit 1000 -D_PLATFORM_ULTRIX_ matrix.o kksolver.o integr.o odesolv.o odeserv.o -lm +rm -f model.c model.h kksolver.c kksolver.o matrix.o integr.o odesolv.o odeserv.o +pixie a.out +a.out.pixie +prof -pixie a.out |more diff --git a/Scripts/kci.bat b/Scripts/kci.bat new file mode 100644 index 0000000..8e880d0 --- /dev/null +++ b/Scripts/kci.bat @@ -0,0 +1,14 @@ +@echo off +rem *********************************************************** +rem * Kinetic Compiler and Integrator * +rem * CopyWrong by Kenneth Geisshirt (kneth@osc.kiku.dk) * +rem * Last updated: 4 July 1994 * +rem *********************************************************** + +go32 d:\science\chemcomp\kc\src\kc -q -m3 < %1 +copy d:\science\chemcomp\kc\solvers\kksolver.c +gcc -O2 -o _simul kksolver.c -lm +go32 _simul +del _simul +del model.c +del kksolver.c diff --git a/Scripts/kkin b/Scripts/kkin new file mode 100755 index 0000000..f7ecb8c --- /dev/null +++ b/Scripts/kkin @@ -0,0 +1,40 @@ + +NAME=`awk '\ + BEGIN { s= "kinwrk.dat.t" }\ + /^name| name|;name/\ + {\ + i= 1;\ + while(i<=NF) {if(index($(i),"\"")>0) break; i++};\ + split($(i),x,"\"");\ + if (length(x[2])>0) s= x[2]".t";\ + }\ + END { print s }' $1` +DATE=`date '+%y%m%d'` +CLCK=`date '+%H%M%S'` +echo "/* RUN IDENTIFICATION: $DATE $CLCK */\n" > $NAME +cat $1 >> $NAME +/users/kneth/bin/kc -m4 < $1 +if [ $? = 2 ] +then + cat kintmp + exit 0 +fi +sed -n -e '1,/FILE LIMIT/w kingconst.p' kintmp +sed -n -e '/derivsinit/,$w kingproc.p' kintmp +rm kintmp + +case $TERM in + ansi | at386) pc -O /osc/kin/kingprog.p /osc/kin/arrh.o \ + /osc/kin/kinansi.o -lcurses;; + adm2) pc -O /osc/kin/kingprog.p /osc/kin/arrh.o \ + /osc/kin/kinadm2.o -lcurses;; + hp98731) pc -O /osc/kin/kingprog.p /osc/kin/arrh.o \ + /osc/kin/kinhp.o -lcurses;; + hp) pc -O /osc/kin/kingprog.p /osc/kin/arrh.o \ + /osc/kin/kinhp.o -lcurses;; + *) pc -O /osc/kin/kingprog.p /osc/kin/arrh.o \ + /osc/kin/kinunknown.o -lcurses;; +esac + +mv a.out "x"$1$2 +"x"$1$2 -p diff --git a/Scripts/kkkin b/Scripts/kkkin new file mode 100644 index 0000000..f4bcd56 --- /dev/null +++ b/Scripts/kkkin @@ -0,0 +1,6 @@ +kc -m3 -q < $1 +cp /users/kneth/Projects/kc/Solvers/kksolvers.c . +cc -O -Aa -o x$1 kksolvers.c -lm +rm -f kksolvers.c +x$1 +rm -f x$1 diff --git a/Scripts/vode b/Scripts/vode new file mode 100755 index 0000000..41483e7 --- /dev/null +++ b/Scripts/vode @@ -0,0 +1,16 @@ +kc -m8 -q < $1 +cp /users/local/num/dvode.o . +cp /users/local/num/dcopy.o . +cp /users/local/num/dgbfa.o . +cp /users/local/num/dgbsl.o . +cp /users/local/num/dgefa.o . +cp /users/local/num/dscal.o . +cp /users/local/num/ddot.o . +cp /users/local/num/idamax.o . +cp /users/local/num/dgesl.o . +cp /users/local/num/daxpy.o . +f77 -O -w -c model.f +f77 -O -w model.o dvode.o dcopy.o dgbfa.o dgbsl.o dgefa.o dscal.o ddot.o idamax.o dgesl.o daxpy.o +rm -f dvode.o model.f model.o dcopy.o dgbfa.o dgbsl.o dgefa.o dscal.o ddot.o idamax.o dgesl.o daxpy.o +a.out +rm -f a.out diff --git a/Solvers/00Index b/Solvers/00Index new file mode 100644 index 0000000..9422c0f --- /dev/null +++ b/Solvers/00Index @@ -0,0 +1,77 @@ +This directory contains a number of numerical routines. This file +explains them briefly. + +KGadi.c +------- +It is a simulation program for reaction-diffusion systems in two +spatial dimensions. The scheme is based on Alternating Direction +Implicit scheme. + +Author: Kenneth Geisshirt. + + +complex.* +--------- +A small library for doing complex computations. + +Author: Kenneth Geisshirt. + + +per1d.c +------- +This is also a simulation program for reaction-diffusion systems, but +it is only for one spatial dimension. It is based on Cranck-Nicolson. + +Author: Kenneth Geisshirt. + + +matrix.* +-------- +A small library for manipulating matrices and vectors. It contains +solvers for systems of linear equations. + +Author: Kenneth Geisshirt. + + +eigen.* +------- +It contains a routine to computing eigenvectors and eigenvalues of a +general matrix. + +Author: Kenneth Geisshirt (based on Keld Nielsen's Pascal code). + + +kksolver.c +---------- +Driver for solvers for ordinary differential equations. + +Authors: Keld Nielsen and Kenneth Geisshirt. + + +odeserv.* +--------- +Service routines for ODE solvers. + +Authors: Keld Nielsen and Kenneth Geisshirt. + + +odesolv.* +--------- +ODE solvers. + +Authors: Keld Nielsen and Kenneth Geisshirt. + + + +integr.* +-------- +A small library for integrating functions. + +Author: Kenneth Geisshirt. + +nonlin.* +-------- +A library of functions to solving nonlinear algrebraic +equations. + +Author: Kenneth Geisshirt diff --git a/Solvers/Makefile b/Solvers/Makefile new file mode 100644 index 0000000..2a6d536 --- /dev/null +++ b/Solvers/Makefile @@ -0,0 +1,43 @@ +OBJECTS = eigen.o complex.o matrix.o integr.o odeserv.o odesolv.o quench.o +YACC = bison +LEX = flex +CC = gcc +CFLAGS = -O2 -D_PLATFORM_GCC_ +LIBS = +YFLAGS = -y +DIST = $(PREFIX)/num + +all: $(OBJECTS) kksolver.c + cp eigen.o $(DIST) + cp eigen.h $(DIST) + cp matrix.o $(DIST) + cp matrix.h $(DIST) + cp complex.o $(DIST) + cp complex.h $(DIST) + cp integr.o $(DIST) + cp integr.h $(DIST) + cp odeserv.o $(DIST) + cp odeserv.h $(DIST) + cp odesolv.o $(DIST) + cp odesolv.h $(DIST) + cp quench.o $(DIST) + cp quench.h $(DIST) + cp kksolver.c $(DIST) + +eigen.o: eigen.c eigen.h + $(CC) $(CFLAGS) -c eigen.c +complex.o: complex.c complex.h + $(CC) $(CFLAGS) -c complex.c +matrix.o: matrix.c matrix.h + $(CC) $(CFLAGS) -c matrix.c +integr.o: integr.c integr.h + $(CC) $(CFLAGS) -c integr.c +odeserv.o: odeserv.h odeserv.c + $(CC) $(CFLAGS) -c odeserv.c +odesolv.o: odesolv.c odesolv.h + $(CC) $(CFLAGS) -c odesolv.c +quench.o: quench.c quench.h + $(CC) $(CFLAGS) -c quench.c + +clean: + rm -f core *.o a.out *~ Makefile diff --git a/Solvers/Makefile.AIX b/Solvers/Makefile.AIX new file mode 100644 index 0000000..6902c68 --- /dev/null +++ b/Solvers/Makefile.AIX @@ -0,0 +1,43 @@ +OBJECTS = eigen.o complex.o matrix.o integr.o odeserv.o odesolv.o quench.o +YACC = yacc +LEX = lex +CC = xlc +CFLAGS = -O3 -qstrict -D_PLATFORM_AIX_ +LIBS = +YFLAGS = +DIST = $(PREFIX)/num + +all: $(OBJECTS) kksolver.c + cp eigen.o $(DIST) + cp eigen.h $(DIST) + cp matrix.o $(DIST) + cp matrix.h $(DIST) + cp complex.o $(DIST) + cp complex.h $(DIST) + cp integr.o $(DIST) + cp integr.h $(DIST) + cp odeserv.o $(DIST) + cp odeserv.h $(DIST) + cp odesolv.o $(DIST) + cp odesolv.h $(DIST) + cp quench.o $(DIST) + cp quench.h $(DIST) + cp kksolver.c $(DIST) + +eigen.o: eigen.c eigen.h + $(CC) $(CFLAGS) -c eigen.c +complex.o: complex.c complex.h + $(CC) $(CFLAGS) -c complex.c +matrix.o: matrix.c matrix.h + $(CC) $(CFLAGS) -c matrix.c +integr.o: integr.c integr.h + $(CC) $(CFLAGS) -c integr.c +odeserv.o: odeserv.h odeserv.c + $(CC) $(CFLAGS) -c odeserv.c +odesolv.o: odesolv.c odesolv.h + $(CC) $(CFLAGS) -c odesolv.c +quench.o: quench.c quench.h + $(CC) $(CFLAGS) -c quench.c + +clean: + rm -f core *.o a.out *~ Makefile diff --git a/Solvers/Makefile.CVX b/Solvers/Makefile.CVX new file mode 100644 index 0000000..f9066b5 --- /dev/null +++ b/Solvers/Makefile.CVX @@ -0,0 +1,43 @@ +OBJECTS = eigen.o complex.o matrix.o integr.o odeserv.o odesolv.o quench.o +YACC = yacc +LEX = lex +CC = cc +CFLAGS = -O -I/usr/include/sys -D_PLATFORM_CONVEX_ +LIBS = +YFLAGS = -y +DIST = $(PREFIX)/num + +all: $(OBJECTS) kksolver.c + cp eigen.o $(DIST) + cp eigen.h $(DIST) + cp matrix.o $(DIST) + cp matrix.h $(DIST) + cp complex.o $(DIST) + cp complex.h $(DIST) + cp integr.o $(DIST) + cp integr.h $(DIST) + cp odeserv.o $(DIST) + cp odeserv.h $(DIST) + cp odesolv.o $(DIST) + cp odesolv.h $(DIST) + cp quench.o $(DIST) + cp quench.h $(DIST) + cp kksolver.c $(DIST) + +eigen.o: eigen.c eigen.h + $(CC) $(CFLAGS) -c eigen.c +complex.o: complex.c complex.h + $(CC) $(CFLAGS) -c complex.c +matrix.o: matrix.c matrix.h + $(CC) $(CFLAGS) -c matrix.c +integr.o: integr.c integr.h + $(CC) $(CFLAGS) -c integr.c +odeserv.o: odeserv.h odeserv.c + $(CC) $(CFLAGS) -c odeserv.c +odesolv.o: odesolv.c odesolv.h + $(CC) $(CFLAGS) -c odesolv.c +quench.o: quench.c quench.h + $(CC) $(CFLAGS) -c quench.c + +clean: + rm -f core *.o a.out *~ Makefile diff --git a/Solvers/Makefile.DOS b/Solvers/Makefile.DOS new file mode 100644 index 0000000..d9ff728 --- /dev/null +++ b/Solvers/Makefile.DOS @@ -0,0 +1,43 @@ +OBJECTS = eigen.o complex.o matrix.o integr.o odeserv.o odesolv.o quench.o +YACC = bison +LEX = flex +CC = gcc +CFLAGS = -O2 -m486 -D_PLATFORM_GCC_ +LIBS = +YFLAGS = -y +DIST = $(PREFIX)/num + +all: $(OBJECTS) kksolver.c + copy eigen.o $(DIST) + copy eigen.h $(DIST) + copy matrix.o $(DIST) + copy matrix.h $(DIST) + copy complex.o $(DIST) + copy complex.h $(DIST) + copy integr.o $(DIST) + copy integr.h $(DIST) + copy odeserv.o $(DIST) + copy odeserv.h $(DIST) + copy odesolv.o $(DIST) + copy odesolv.h $(DIST) + copy quench.o $(DIST) + copy quench.h $(DIST) + copy kksolver.c $(DIST) + +eigen.o: eigen.c eigen.h + $(CC) $(CFLAGS) -c eigen.c +complex.o: complex.c complex.h + $(CC) $(CFLAGS) -c complex.c +matrix.o: matrix.c matrix.h + $(CC) $(CFLAGS) -c matrix.c +integr.o: integr.c integr.h + $(CC) $(CFLAGS) -c integr.c +odeserv.o: odeserv.h odeserv.c + $(CC) $(CFLAGS) -c odeserv.c +odesolv.o: odesolv.c odesolv.h + $(CC) $(CFLAGS) -c odesolv.c +quench.o: quench.c quench.h + $(CC) $(CFLAGS) -c quench.c + +clean: + del core *.o a.out *~ Makefile diff --git a/Solvers/Makefile.GCC b/Solvers/Makefile.GCC new file mode 100644 index 0000000..2a6d536 --- /dev/null +++ b/Solvers/Makefile.GCC @@ -0,0 +1,43 @@ +OBJECTS = eigen.o complex.o matrix.o integr.o odeserv.o odesolv.o quench.o +YACC = bison +LEX = flex +CC = gcc +CFLAGS = -O2 -D_PLATFORM_GCC_ +LIBS = +YFLAGS = -y +DIST = $(PREFIX)/num + +all: $(OBJECTS) kksolver.c + cp eigen.o $(DIST) + cp eigen.h $(DIST) + cp matrix.o $(DIST) + cp matrix.h $(DIST) + cp complex.o $(DIST) + cp complex.h $(DIST) + cp integr.o $(DIST) + cp integr.h $(DIST) + cp odeserv.o $(DIST) + cp odeserv.h $(DIST) + cp odesolv.o $(DIST) + cp odesolv.h $(DIST) + cp quench.o $(DIST) + cp quench.h $(DIST) + cp kksolver.c $(DIST) + +eigen.o: eigen.c eigen.h + $(CC) $(CFLAGS) -c eigen.c +complex.o: complex.c complex.h + $(CC) $(CFLAGS) -c complex.c +matrix.o: matrix.c matrix.h + $(CC) $(CFLAGS) -c matrix.c +integr.o: integr.c integr.h + $(CC) $(CFLAGS) -c integr.c +odeserv.o: odeserv.h odeserv.c + $(CC) $(CFLAGS) -c odeserv.c +odesolv.o: odesolv.c odesolv.h + $(CC) $(CFLAGS) -c odesolv.c +quench.o: quench.c quench.h + $(CC) $(CFLAGS) -c quench.c + +clean: + rm -f core *.o a.out *~ Makefile diff --git a/Solvers/Makefile.HPUX b/Solvers/Makefile.HPUX new file mode 100644 index 0000000..5f0b762 --- /dev/null +++ b/Solvers/Makefile.HPUX @@ -0,0 +1,43 @@ +OBJECTS = eigen.o complex.o matrix.o integr.o odeserv.o odesolv.o quench.o +YACC = yacc +LEX = lex +CC = cc +CFLAGS = -Aa -O -D_PLATFORM_HPUX_ +LIBS = +YFLAGS = +DIST = $(PREFIX)/num + +all: $(OBJECTS) kksolver.c + cp eigen.o $(DIST) + cp eigen.h $(DIST) + cp matrix.o $(DIST) + cp matrix.h $(DIST) + cp complex.o $(DIST) + cp complex.h $(DIST) + cp integr.o $(DIST) + cp integr.h $(DIST) + cp odeserv.o $(DIST) + cp odeserv.h $(DIST) + cp odesolv.o $(DIST) + cp odesolv.h $(DIST) + cp quench.o $(DIST) + cp quench.h $(DIST) + cp kksolver.c $(DIST) + +eigen.o: eigen.c eigen.h + $(CC) $(CFLAGS) -c eigen.c +complex.o: complex.c complex.h + $(CC) $(CFLAGS) -c complex.c +matrix.o: matrix.c matrix.h + $(CC) $(CFLAGS) -c matrix.c +integr.o: integr.c integr.h + $(CC) $(CFLAGS) -c integr.c +odeserv.o: odeserv.h odeserv.c + $(CC) $(CFLAGS) -c odeserv.c +odesolv.o: odesolv.c odesolv.h + $(CC) $(CFLAGS) -c odesolv.c +quench.o: quench.c quench.h + $(CC) $(CFLAGS) -c quench.c + +clean: + rm -f core *.o a.out *~ Makefile diff --git a/Solvers/Makefile.KIN b/Solvers/Makefile.KIN new file mode 100644 index 0000000..1a18d04 --- /dev/null +++ b/Solvers/Makefile.KIN @@ -0,0 +1,43 @@ +OBJECTS = eigen.o complex.o matrix.o integr.o odeserv.o odesolv.o quench.o +YACC = bison +LEX = flex +CC = gcc +CFLAGS = -O3 -D_PLATFORM_GCC_ +LIBS = +YFLAGS = -y +DIST = $(PREFIX)/num + +all: $(OBJECTS) kksolver.c + cp eigen.o $(DIST) + cp eigen.h $(DIST) + cp matrix.o $(DIST) + cp matrix.h $(DIST) + cp complex.o $(DIST) + cp complex.h $(DIST) + cp integr.o $(DIST) + cp integr.h $(DIST) + cp odeserv.o $(DIST) + cp odeserv.h $(DIST) + cp odesolv.o $(DIST) + cp odesolv.h $(DIST) + cp quench.o $(DIST) + cp quench.h $(DIST) + cp kksolver.c $(DIST) + +eigen.o: eigen.c eigen.h + $(CC) $(CFLAGS) -c eigen.c +complex.o: complex.c complex.h + $(CC) $(CFLAGS) -c complex.c +matrix.o: matrix.c matrix.h + $(CC) $(CFLAGS) -c matrix.c +integr.o: integr.c integr.h + $(CC) $(CFLAGS) -c integr.c +odeserv.o: odeserv.h odeserv.c + $(CC) $(CFLAGS) -c odeserv.c +odesolv.o: odesolv.c odesolv.h + $(CC) $(CFLAGS) -c odesolv.c +quench.o: quench.c quench.h + $(CC) $(CFLAGS) -c quench.c + +clean: + rm -f core *.o a.out *~ Makefile diff --git a/Solvers/Makefile.LINUX b/Solvers/Makefile.LINUX new file mode 100644 index 0000000..6df2dcf --- /dev/null +++ b/Solvers/Makefile.LINUX @@ -0,0 +1,43 @@ +OBJECTS = eigen.o complex.o matrix.o integr.o odeserv.o odesolv.o quench.o +YACC = bison +LEX = flex +CC = gcc +CFLAGS = -O2 -m486 -D_PLATFORM_LINUX_ +LIBS = +YFLAGS = -y +DIST = $(PREFIX)/num + +all: $(OBJECTS) kksolver.c + cp eigen.o $(DIST) + cp eigen.h $(DIST) + cp matrix.o $(DIST) + cp matrix.h $(DIST) + cp complex.o $(DIST) + cp complex.h $(DIST) + cp integr.o $(DIST) + cp integr.h $(DIST) + cp odeserv.o $(DIST) + cp odeserv.h $(DIST) + cp odesolv.o $(DIST) + cp odesolv.h $(DIST) + cp quench.o $(DIST) + cp quench.h $(DIST) + cp kksolver.c $(DIST) + +eigen.o: eigen.c eigen.h + $(CC) $(CFLAGS) -c eigen.c +complex.o: complex.c complex.h + $(CC) $(CFLAGS) -c complex.c +matrix.o: matrix.c matrix.h + $(CC) $(CFLAGS) -c matrix.c +integr.o: integr.c integr.h + $(CC) $(CFLAGS) -c integr.c +odeserv.o: odeserv.h odeserv.c + $(CC) $(CFLAGS) -c odeserv.c +odesolv.o: odesolv.c odesolv.h + $(CC) $(CFLAGS) -c odesolv.c +quench.o: quench.c quench.h + $(CC) $(CFLAGS) -c quench.c + +clean: + rm -f core *.o a.out *~ Makefile diff --git a/Solvers/Makefile.SGI b/Solvers/Makefile.SGI new file mode 100644 index 0000000..2ad977e --- /dev/null +++ b/Solvers/Makefile.SGI @@ -0,0 +1,43 @@ +OBJECTS = eigen.o complex.o matrix.o integr.o odeserv.o odesolv.o quench.o +YACC = yacc +LEX = lex +CC = cc +CFLAGS = -O -D_PLATFORM_SGI_ -ansi -w +LIBS = +YFLAGS = +DIST = $(PREFIX)/num + +all: $(OBJECTS) kksolver.c + cp eigen.o $(DIST) + cp eigen.h $(DIST) + cp matrix.o $(DIST) + cp matrix.h $(DIST) + cp complex.o $(DIST) + cp complex.h $(DIST) + cp integr.o $(DIST) + cp integr.h $(DIST) + cp odeserv.o $(DIST) + cp odeserv.h $(DIST) + cp odesolv.o $(DIST) + cp odesolv.h $(DIST) + cp quench.o $(DIST) + cp quench.h $(DIST) + cp kksolver.c $(DIST) + +eigen.o: eigen.c eigen.h + $(CC) $(CFLAGS) -c eigen.c +complex.o: complex.c complex.h + $(CC) $(CFLAGS) -c complex.c +matrix.o: matrix.c matrix.h + $(CC) $(CFLAGS) -c matrix.c +integr.o: integr.c integr.h + $(CC) $(CFLAGS) -c integr.c +odeserv.o: odeserv.h odeserv.c + $(CC) $(CFLAGS) -c odeserv.c +odesolv.o: odesolv.c odesolv.h + $(CC) $(CFLAGS) -c odesolv.c +quench.o: quench.c quench.h + $(CC) $(CFLAGS) -c quench.c + +clean: + rm -f core *.o a.out *~ Makefile diff --git a/Solvers/Makefile.ULTRI b/Solvers/Makefile.ULTRI new file mode 100644 index 0000000..fe3ed91 --- /dev/null +++ b/Solvers/Makefile.ULTRI @@ -0,0 +1,43 @@ +OBJECTS = eigen.o complex.o matrix.o integr.o odeserv.o odesolv.o quench.o +YACC = yacc +LEX = lex +CC = cc +CFLAGS = -O2 -w -Olimit 1000 -D_PLATFORM_ULTRIX_ +LIBS = +YFLAGS = +DIST = $(PREFIX)/num + +all: $(OBJECTS) kksolver.c + cp eigen.o $(DIST) + cp eigen.h $(DIST) + cp matrix.o $(DIST) + cp matrix.h $(DIST) + cp complex.o $(DIST) + cp complex.h $(DIST) + cp integr.o $(DIST) + cp integr.h $(DIST) + cp odeserv.o $(DIST) + cp odeserv.h $(DIST) + cp odesolv.o $(DIST) + cp odesolv.h $(DIST) + cp quench.o $(DIST) + cp quench.h $(DIST) + cp kksolver.c $(DIST) + +eigen.o: eigen.c eigen.h + $(CC) $(CFLAGS) -c eigen.c +complex.o: complex.c complex.h + $(CC) $(CFLAGS) -c complex.c +matrix.o: matrix.c matrix.h + $(CC) $(CFLAGS) -c matrix.c +integr.o: integr.c integr.h + $(CC) $(CFLAGS) -c integr.c +odeserv.o: odeserv.h odeserv.c + $(CC) $(CFLAGS) -c odeserv.c +odesolv.o: odesolv.c odesolv.h + $(CC) $(CFLAGS) -c odesolv.c +quench.o: quench.c quench.h + $(CC) $(CFLAGS) -c quench.c + +clean: + rm -f core *.o a.out *~ Makefile diff --git a/Solvers/complex.c b/Solvers/complex.c new file mode 100644 index 0000000..ee5578b --- /dev/null +++ b/Solvers/complex.c @@ -0,0 +1,67 @@ +/***************************************************************************** + Complex - a small library for doing complex algebra in C. + + CopyWrong 1994 by + Kenneth Geisshirt (kneth@osc.kiku.dk) + Department of Theoretical Chemstry + H.C. Orsted Institute + Universitetsparken 5 + 2100 Copenhagen 5 + Denmark + + Last updated: 12 September 1994 +******************************************************************************/ + + +#include +#include "complex.h" + +void ComplexAssign(double re, double im, Complex *z) { + + z->re=re; + z->im=im; +} /* ComplexAssign */ + + +void ComplexAdd(Complex z1, Complex z2, Complex *res) { + + res->re=z1.re+z2.re; + res->im=z1.im+z2.im; +} /* ComplexAdd */ + + +void ComplexSub(Complex z1, Complex z2, Complex *res) { + + res->re=z1.re-z2.re; + res->im=z1.im-z2.im; +} /* ComplexSub */ + + +void ComplexMul(Complex z1, Complex z2, Complex *res) { + + res->re=z1.re*z2.re-z1.im*z2.im; + res->im=z1.re*z2.im+z1.im*z2.re; +} /* ComplexMul */ + + +void ComplexDiv(Complex a, Complex b, Complex *res) { + + double temp; + + temp=b.re*b.re+b.im*b.im; + res->re=(a.re*b.re+a.im*b.im)/temp; + res->im=(a.im*b.re-a.re*b.im)/temp; +} /* ComplexDiv */ + + +double ComplexNorm(Complex z) { + + return (sqrt(z.re*z.re+z.im*z.im)); +} /* ComplexNorm */ + + +double ComplexArg(Complex z) { + + return (atan2(z.im, z.re)); +} /* ComplexArg */ + diff --git a/Solvers/complex.h b/Solvers/complex.h new file mode 100644 index 0000000..398fd56 --- /dev/null +++ b/Solvers/complex.h @@ -0,0 +1,32 @@ +/***************************************************************************** + Complex - a small library for doing complex algebra in C. + + CopyWrong 1994 by + Kenneth Geisshirt (kneth@osc.kiku.dk) + Department of Theoretical Chemstry + H.C. Orsted Institute + Universitetsparken 5 + 2100 Copenhagen 5 + Denmark + + Last updated: 20 August 1994 +******************************************************************************/ + +#ifndef _COMPLEX_LIB_ +#define _COMPLEX_LIB_ + +struct ComplexStruct { + double re, im; +}; + +typedef struct ComplexStruct Complex; + +extern void ComplexAssign(double, double, Complex *); +extern void ComplexAdd(Complex, Complex, Complex *); +extern void ComplexSub(Complex, Complex, Complex *); +extern void ComplexMul(Complex, Complex, Complex *); +extern void ComplexDiv(Complex, Complex, Complex *); +extern double ComplexNorm(Complex); +extern double ComplexArg(Complex); + +#endif diff --git a/Solvers/eigen-te.c b/Solvers/eigen-te.c new file mode 100644 index 0000000..0ce9e3b --- /dev/null +++ b/Solvers/eigen-te.c @@ -0,0 +1,60 @@ +/************************************************************************** + A small test of the eigenvalue library. The test example comes from + many sources. + + CopyWrong 1994-1995 by Kenneth Geisshirt. + + Last updated: 9 November 1995 +***************************************************************************/ + +#include + +#include "eigen.h" +#include "matrix.h" +#include "complex.h" + +void main(void) { + + double **A; /* matrices */ + Complex *val, **vecs; + int i, j; + + A=MatrixAlloc(3); + val=ComplexVectorAlloc(3); + vecs=ComplexMatrixAlloc(3); + + printf("Matrix 1:\n"); + A[0][0]=1.000; A[0][1]=0.000; A[0][2]=0.010; + A[1][0]=0.100; A[1][1]=1.000; A[1][2]=0.000; + A[2][0]=0.000; A[2][1]=1.000; A[2][2]=1.000; + + Eigen(3, 1, A, 150, 1.0e-15, 0, val, vecs); + + printf("Eigenvalues:\n"); + for(i=0; i<3; i++) + printf(" (%e, %e)\n", val[i].re, val[i].im); + printf("\nEigenvectors:\n"); + for(i=0; i<3; i++) { + for(j=0; j<3; j++) + printf(" (%e, %e)\n", vecs[i][j].re, vecs[i][j].im); + printf("\n"); + } + + printf("Matrix 2:\n"); + A[0][0]=1.000; A[0][1]=0.000; A[0][2]=0.000; + A[1][0]=0.000; A[1][1]=2.000; A[1][2]=0.000; + A[2][0]=0.000; A[2][1]=0.000; A[2][2]=3.000; + + Eigen(3, 1, A, 150, 1.0e-15, 0, val, vecs); + + printf("Eigenvalues:\n"); + for(i=0; i<3; i++) + printf(" (%e, %e)\n", val[i].re, val[i].im); + printf("\nEigenvectors:\n"); + for(i=0; i<3; i++) { + for(j=0; j<3; j++) + printf(" (%e, %e)\n", vecs[i][j].re, vecs[i][j].im); + printf("\n"); + } +} + diff --git a/Solvers/eigen-te.c0 b/Solvers/eigen-te.c0 new file mode 100644 index 0000000..0ce9e3b --- /dev/null +++ b/Solvers/eigen-te.c0 @@ -0,0 +1,60 @@ +/************************************************************************** + A small test of the eigenvalue library. The test example comes from + many sources. + + CopyWrong 1994-1995 by Kenneth Geisshirt. + + Last updated: 9 November 1995 +***************************************************************************/ + +#include + +#include "eigen.h" +#include "matrix.h" +#include "complex.h" + +void main(void) { + + double **A; /* matrices */ + Complex *val, **vecs; + int i, j; + + A=MatrixAlloc(3); + val=ComplexVectorAlloc(3); + vecs=ComplexMatrixAlloc(3); + + printf("Matrix 1:\n"); + A[0][0]=1.000; A[0][1]=0.000; A[0][2]=0.010; + A[1][0]=0.100; A[1][1]=1.000; A[1][2]=0.000; + A[2][0]=0.000; A[2][1]=1.000; A[2][2]=1.000; + + Eigen(3, 1, A, 150, 1.0e-15, 0, val, vecs); + + printf("Eigenvalues:\n"); + for(i=0; i<3; i++) + printf(" (%e, %e)\n", val[i].re, val[i].im); + printf("\nEigenvectors:\n"); + for(i=0; i<3; i++) { + for(j=0; j<3; j++) + printf(" (%e, %e)\n", vecs[i][j].re, vecs[i][j].im); + printf("\n"); + } + + printf("Matrix 2:\n"); + A[0][0]=1.000; A[0][1]=0.000; A[0][2]=0.000; + A[1][0]=0.000; A[1][1]=2.000; A[1][2]=0.000; + A[2][0]=0.000; A[2][1]=0.000; A[2][2]=3.000; + + Eigen(3, 1, A, 150, 1.0e-15, 0, val, vecs); + + printf("Eigenvalues:\n"); + for(i=0; i<3; i++) + printf(" (%e, %e)\n", val[i].re, val[i].im); + printf("\nEigenvectors:\n"); + for(i=0; i<3; i++) { + for(j=0; j<3; j++) + printf(" (%e, %e)\n", vecs[i][j].re, vecs[i][j].im); + printf("\n"); + } +} + diff --git a/Solvers/eigen-te.c01 b/Solvers/eigen-te.c01 new file mode 100644 index 0000000..0ce9e3b --- /dev/null +++ b/Solvers/eigen-te.c01 @@ -0,0 +1,60 @@ +/************************************************************************** + A small test of the eigenvalue library. The test example comes from + many sources. + + CopyWrong 1994-1995 by Kenneth Geisshirt. + + Last updated: 9 November 1995 +***************************************************************************/ + +#include + +#include "eigen.h" +#include "matrix.h" +#include "complex.h" + +void main(void) { + + double **A; /* matrices */ + Complex *val, **vecs; + int i, j; + + A=MatrixAlloc(3); + val=ComplexVectorAlloc(3); + vecs=ComplexMatrixAlloc(3); + + printf("Matrix 1:\n"); + A[0][0]=1.000; A[0][1]=0.000; A[0][2]=0.010; + A[1][0]=0.100; A[1][1]=1.000; A[1][2]=0.000; + A[2][0]=0.000; A[2][1]=1.000; A[2][2]=1.000; + + Eigen(3, 1, A, 150, 1.0e-15, 0, val, vecs); + + printf("Eigenvalues:\n"); + for(i=0; i<3; i++) + printf(" (%e, %e)\n", val[i].re, val[i].im); + printf("\nEigenvectors:\n"); + for(i=0; i<3; i++) { + for(j=0; j<3; j++) + printf(" (%e, %e)\n", vecs[i][j].re, vecs[i][j].im); + printf("\n"); + } + + printf("Matrix 2:\n"); + A[0][0]=1.000; A[0][1]=0.000; A[0][2]=0.000; + A[1][0]=0.000; A[1][1]=2.000; A[1][2]=0.000; + A[2][0]=0.000; A[2][1]=0.000; A[2][2]=3.000; + + Eigen(3, 1, A, 150, 1.0e-15, 0, val, vecs); + + printf("Eigenvalues:\n"); + for(i=0; i<3; i++) + printf(" (%e, %e)\n", val[i].re, val[i].im); + printf("\nEigenvectors:\n"); + for(i=0; i<3; i++) { + for(j=0; j<3; j++) + printf(" (%e, %e)\n", vecs[i][j].re, vecs[i][j].im); + printf("\n"); + } +} + diff --git a/Solvers/eigen-test.c b/Solvers/eigen-test.c new file mode 100644 index 0000000..0ce9e3b --- /dev/null +++ b/Solvers/eigen-test.c @@ -0,0 +1,60 @@ +/************************************************************************** + A small test of the eigenvalue library. The test example comes from + many sources. + + CopyWrong 1994-1995 by Kenneth Geisshirt. + + Last updated: 9 November 1995 +***************************************************************************/ + +#include + +#include "eigen.h" +#include "matrix.h" +#include "complex.h" + +void main(void) { + + double **A; /* matrices */ + Complex *val, **vecs; + int i, j; + + A=MatrixAlloc(3); + val=ComplexVectorAlloc(3); + vecs=ComplexMatrixAlloc(3); + + printf("Matrix 1:\n"); + A[0][0]=1.000; A[0][1]=0.000; A[0][2]=0.010; + A[1][0]=0.100; A[1][1]=1.000; A[1][2]=0.000; + A[2][0]=0.000; A[2][1]=1.000; A[2][2]=1.000; + + Eigen(3, 1, A, 150, 1.0e-15, 0, val, vecs); + + printf("Eigenvalues:\n"); + for(i=0; i<3; i++) + printf(" (%e, %e)\n", val[i].re, val[i].im); + printf("\nEigenvectors:\n"); + for(i=0; i<3; i++) { + for(j=0; j<3; j++) + printf(" (%e, %e)\n", vecs[i][j].re, vecs[i][j].im); + printf("\n"); + } + + printf("Matrix 2:\n"); + A[0][0]=1.000; A[0][1]=0.000; A[0][2]=0.000; + A[1][0]=0.000; A[1][1]=2.000; A[1][2]=0.000; + A[2][0]=0.000; A[2][1]=0.000; A[2][2]=3.000; + + Eigen(3, 1, A, 150, 1.0e-15, 0, val, vecs); + + printf("Eigenvalues:\n"); + for(i=0; i<3; i++) + printf(" (%e, %e)\n", val[i].re, val[i].im); + printf("\nEigenvectors:\n"); + for(i=0; i<3; i++) { + for(j=0; j<3; j++) + printf(" (%e, %e)\n", vecs[i][j].re, vecs[i][j].im); + printf("\n"); + } +} + diff --git a/Solvers/eigen.c b/Solvers/eigen.c new file mode 100644 index 0000000..2028f05 --- /dev/null +++ b/Solvers/eigen.c @@ -0,0 +1,926 @@ +/***************************************************************************** + Eigen is a library for computing eigenvalues and eigenvectors of general + matrices. There is only one routine exported, namely Eigen. + + CopyWrong 1994-1995 by + Kenneth Geisshirt (kneth@osc.kiku.dk) + Department of Theoretical Chemistry + H.C. Orsted Institute + Universitetsparken 5 + 2100 Copenhagen + Denmark + + See eigen.h for details. + + Last updated: 16 October 1995 +*****************************************************************************/ + +#include "complex.h" +#include "matrix.h" +#include +#include + +void BlockCheck(double **A, int n, int i, int *block, double epsx) { + + /* block == 1 <=> TRUE, block == 0 <=> FALSE */ + + if (i==n) + *block=0; + else { + if ((fabs(A[i-1][i]-A[i][i-1])>epsx) && + (fabs(A[i-1][i-1]-A[i][i])<=epsx)) + *block=1; + else + *block=0; + } /* else */ +} /* BlockCheck */ + + +void PrintEigen(int n, double **A, double **B, double eps, FILE *outfile) { + + int i, j; + int block; + + fprintf(outfile, "\nEigenvalues:\t\t\tRe\t\t\tIm\n"); + i=1; + do { + BlockCheck(A, n, i, &block, eps); + if (block==1) { + fprintf(outfile, "\t\t\t\t%e\t\t%e\n", A[i-1][i-1], A[i-1][i]); + fprintf(outfile, "\t\t\t\t%e\t\t%e\n", A[i][i], A[i][i-1]); + i+=2; + } else { + fprintf(outfile, "\t\t\t\t%e\t\t%e\n", A[i-1][i-1], 0.0); + i++; + } /* if else */ + } while (i!=(n+1)); + fprintf(outfile, "\nEigenvectors:\t\t\tRe\t\t\tIm\n"); + i=1; + do { + BlockCheck(A, n, i, &block, eps); + if (block==1) { + for(j=1; j<=n; j++) + fprintf(outfile, "\t\t\t\t%e\t\t%e\n", B[j-1][i-1], B[j-1][i]); + fprintf(outfile, "\n"); + for(j=1; j<=n; j++) + fprintf(outfile, "\t\t\t\t%e\t\t%e\n", B[j-1][i-1], -B[j-1][i]); + fprintf(outfile, "\n"); + i+=2; + } else { + for(j=1; j<=n; j++) + fprintf(outfile, "\t\t\t\t%e\t\t%e\n", B[j-1][i-1], 0.0); + fprintf(outfile, "\n"); + i++; + } /* if else */ + } while (i!=(n+1)); +} /* PrintEigen */ + + +void NormalizingMatrix(int n, double **A, int fixedref, int *ref, + double **V, double eps) { + + int j, col, block; + Complex c1, c2, c3; + double cd1, cd2, sqrnorm, norm, normi, max; + + col=1; + do { + if (fixedref==0) { + *ref=1; + ComplexAssign(V[*ref-1][col-1], V[*ref-1][col], &c1); + max=ComplexNorm(c1); + for(j=2; j<=n; j++) { + ComplexAssign(V[j-1][col-1], V[j-1][col], &c2); + sqrnorm=ComplexNorm(c2); + if (sqrnorm>max) { + *ref=j; + max=sqrnorm; + } /* if */ + } /* for j */ + } /* if fixedref */ + BlockCheck(A, n, col, &block, eps); + if (block==1) { + ComplexAssign(V[*ref-1][col-1], V[*ref-1][col], &c1); + for(j=1; j<=n; j++) { + ComplexAssign(V[j-1][col-1], V[j-1][col], &c2); + ComplexDiv(c2, c1, &c3); + V[j-1][col-1]=c3.re; + V[j-1][col]=c3.im; + } /* for j */ + col+=2; + } /* if */ + else { + norm=fabs(V[*ref-1][col-1]); + if (norm!=0.0) + for(j=1; j<=n; j++) + V[j-1][col-1]/=norm; + col++; + } /* else */ + } while (col<=n); +} /* NormalizingMatrix */ + +void Permutation(int n, double **P, double **A, double **B, int colon, + double eps) { + + int *nr; + int block, OK; + double max, y, x; + int im, j, ki, u, v, i, k, ii; + double **AA; + + nr=IntVectorAlloc(n); + AA=MatrixAlloc(n); + + MatrixCopy(n, AA, A); + for(i=1; i<=n; i++) { + nr[i-1]=i; + for(k=1; k<=n; k++) + P[i-1][k-1]=0.0; + } /* for i */ + i=ii=ki=1; + while (i0.0) { + A[i][i-1]=A[i-1][i]; + A[i-1][i]=-A[i][i-1]; + AA[i][i-1]=AA[i-1][i]; + AA[i-1][i]=-AA[i][i-1]; + for(j=1; j<=n; j++) + B[j-1][i]=-B[j-1][i]; + } else { + A[i][i-1]=-A[i-1][i]; + AA[i][i-1]=-AA[i-1][i]; + } /* else */ + j=i; + for(k=ii; k<=(ii+1); k++) { + x=AA[k-1][k-1]; + AA[k-1][k-1]=A[j-1][j-1]; + AA[j-1][j-1]=x; + u=nr[k-1]; + nr[k-1]=nr[j-1]; + nr[j-1]=u; + j++; + } /* for k */ + if (ii>1) { + if (AA[ii-1][ii-1]>AA[0][0]) { + j=ii; + for(k=1; k<=2; k++) { + x=AA[k-1][k-1]; + AA[k-1][k-1]=A[j-1][j-1]; + AA[j-1][j-1]=x; + u=nr[k-1]; + nr[k-1]=nr[j-1]; + nr[j-1]=u; + j++; + } /* for k */ + } /* if */ + } /* if */ + ki=i; + i+=2; + ii+=2; + } /* if */ + else + i++; + } /* while */ + + if (n>3) { + do { + im=ii; + i=ii; + max=AA[im-1][im-1]; + do { + i++; + if (AA[i-1][i-1]>max) { + im=i; + max=AA[i-1][i-1]; + } /* if */ + } while (iii) { + x=AA[ii-1][ii-1]; + u=nr[ii-1]; + AA[ii-1][ii-1]=max; + nr[ii-1]=nr[im-1]; + AA[im-1][im-1]=x; + nr[im-1]=u; + } /* if */ + ii++; + } while (ii=1; j--) { + r=0.0; + for(i=1; i<=(j-1); i++) + r+=fabs(a[j-1][i-1]); + for(i=(j+1); i<=k; i++) + r+=fabs(a[j-1][i-1]); + if (r==0.0) { + d[k-1]=(double)j; + if (j!=k) { + for(i=1; i<=k; i++) { + f=a[i-1][j-1]; + a[i-1][j-1]=a[i-1][k-1]; + a[i-1][k-1]=f; + } + for(i=l; i<=n; i++) { + f=a[j-1][i-1]; + a[j-1][i-1]=a[k-1][i-1]; + a[k-1][i-1]=f; + } + } + k--; + goto L110; + } /* if */ + } /* for j */ + + L120: + for(j=l; j<=k; j++) { + c=0.0; + for (i=l; i<=(j-1); i++) + c+=fabs(a[i-1][j-1]); + for(i=(j+1); i<=k; i++) + c+=fabs(a[i-1][j-1]); + if (c==0.0) { + d[l-1]=(double)j; + if (j!=l) { + for(i=1; i<=k; i++) { + f=a[i-1][j-1]; + a[i-1][j-1]=a[i-1][l-1]; + a[i-1][l-1]=f; + } + for(i=l; i<=n; i++) { + f=a[j-1][i-1]; + a[j-1][i-1]=a[l-1][i-1]; + a[l-1][i-1]=f; + } + } + l++; + goto L120; + } /* if */ + } /* for j */ + + *low=l; + *hi=k; + for(i=l; i<=k; i++) + d[i-1]=1.0; + + L130: + noconv=0; + for(i=l; i<=k; i++) { + r=c=0.0; + for(j=l; j<=(i-1); j++) { + c+=fabs(a[j-1][i-1]); + r+=fabs(a[i-1][j-1]); + } /* for j */ + for(j=(i+1); j<=k; j++) { + c+=fabs(a[j-1][i-1]); + r+=fabs(a[i-1][j-1]); + } /* for j */ + g=r/((double) b); + f=1.0; + s=c+r; + + L140: + if (c=g) { + f/=(double) b; + c/=(double) b2; + goto L150; + } /* if */ + + if ((c+r)/f<(0.95*s)) { + g=1.0/f; + d[i-1]*=f; + noconv=1; + for(j=l; j<=n; j++) + a[i-1][j-1]*=g; + for(j=1; j<=k; j++) + a[j-1][i-1]*=f; + } /* if */ + } /* for i */ + if (noconv==1) + goto L130; +} /* Balance */ + +void BalBak(int n, int low, int hi, int m, double **z, double *d) { + + int i, j, k; + double s; + + for(i=low; i<=hi; i++) { + s=d[i-1]; + for(j=1; j<=m; j++) + z[i-1][j-1]*=s; + } /* for i */ + for(i=(low-1); i>=1; i--) { + k=(int)floor(d[i-1]+0.5); + if (k!=i) + for(j=1; j<=m; j++) { + s=z[i-1][j-1]; + z[i-1][j-1]=z[k-1][j-1]; + z[k-1][j-1]=s; + } /* for j */ + } /* for i */ + for(i=(hi+1); i<=n; i++) { + k=(int)floor(d[i-1]+0.5); + if (k!=i) + for(j=1; j<=m; j++) { + s=z[i-1][j-1]; + z[i-1][j-1]=z[k-1][j-1]; + z[k-1][j-1]=s; + } /* for j */ + } /* for i */ +} /* BalBak */ + +void Elmhes(int n, int k, int l, double **a, int *index) { + + int i, j, la, m; + double x, y; + + la=l-1; + for(m=(k+1); m<=la; m++) { + i=m; + x=0.0; + for(j=m; j<=l; j++) + if (fabs(a[j-1][m-2])>fabs(x)) { + x=a[j-1][m-2]; + i=j; + } /* if */ + index[m-1]=i; + if (i!=m) { + for(j=(m-1); j<=n; j++) { + y=a[i-1][j-1]; + a[i-1][j-1]=a[m-1][j-1]; + a[m-1][j-1]=y; + } /* for j */ + for(j=1; j<=l; j++) { + y=a[j-1][i-1]; + a[j-1][i-1]=a[j-1][m-1]; + a[j-1][m-1]=y; + } /* for j */ + } /* if */ + if (x!=0.0) + for(i=(m+1); i<=l; i++) { + y=a[i-1][m-2]; + if (y!=0.0) { + a[i-1][m-2]=y/x; + y/=x; + for(j=m; j<=n; j++) + a[i-1][j-1]-=y*a[m-1][j-1]; + for(j=1; j<=l; j++) + a[j-1][m-1]+=y*a[j-1][i-1]; + } /* if */ + } /* for i */ + } /* for m */ +} /* Elmhes */ + +void Elmtrans(int n, int low, int upp, double **h, int *index, + double **v) { + + int i, j, k; + + for(i=1; i<=n; i++) { + for(j=1; j<=n; j++) + v[i-1][j-1]=0.0; + v[i-1][i-1]=1.0; + } /* for i */ + for(i=(upp-1); i>=(low+1); i--) { + j=index[i-1]; + for(k=(i+1); k<=upp; k++) + v[k-1][i-1]=h[k-1][i-2]; + if (i!=j) { + for(k=i; k<=upp; k++) { + v[i-1][k-1]=v[j-1][k-1]; + v[j-1][k-1]=0.0; + } /* for k */ + v[j-1][i-1]=1.0; + } /* if */ + } /* for i */ +} /* Elmtrans */ + + +void hqr2(int n, int low, int upp, int maxits, double macheps, + double **h, double **vecs, double *wr, + double *wi, int *cnt, int *fail) { + + int i, j, k, l, m, na, its, en, dummy; + double p, q, r, s, t, w, x, y, z, ra, sa, vr, vi, norm; + int notlast; + Complex c1, c2, c3; + + *fail=0; + for(i=1; i<=(low-1); i++) { + wr[i-1]=h[i-1][i-1]; + wi[i-1]=0.0; + cnt[i-1]=0; + } /* for i */ + for(i=(upp+1); i<=n; i++) { + wr[i-1]=h[i-1][i-1]; + wi[i-1]=0.0; + cnt[i-1]=0; + } /* for i */ + en=upp; + t=0.0; + + L210: + if (en=(low+1); l--) + if (fabs(h[l-1][l-2])<= + macheps*(fabs(h[l-2][l-2])+fabs(h[l-1][l-1]))) + goto L231; + l=low; + + L231: + x=h[en-1][en-1]; + if (l==en) + goto L240; + y=h[na-1][na-1]; + w=h[en-1][na-1]*h[na-1][en-1]; + if (l==na) + goto L250; + if (its==maxits) { + cnt[en-1]=maxits+1; + *fail=1; + goto L270; + } /* if */ + if ((its % 10)==0) { + t+=x; + for(i=low; i<=en; i++) + h[i-1][i-1]-=x; + s=fabs(h[en-1][na-1])+fabs(h[na-1][en-3]); + y=0.75*s; + x=y; + w=-0.4375*s*s; + } /* if */ + its++; + + for(m=(en-2); m>=l; m--) { + z=h[m-1][m-1]; + r=x-z; + s=y-z; + p=(r*s-w)/h[m][m-1]+h[m-1][m]; + q=h[m][m]-z-r-s; + r=h[m+1][m]; + s=fabs(p)+fabs(q)+fabs(r); + p/=s; + q/=s; + r/=s; + if (m==1) + goto L232; + if ((fabs(h[m-1][m-2])*(fabs(q)+fabs(r)))<= + (macheps*fabs(p)*(fabs(h[m-2][m-2])+fabs(z)+fabs(h[m][m])))) + goto L232; + } /* for m */ + + L232: + for(i=(m+2); i<=en; i++) + h[i-1][i-3]=0.0; + for(i=(m+3); i<=en; i++) + h[i-1][i-4]=0.0; + + for(k=m; k<=na; k++) { + if (k!=na) + notlast=1; + else + notlast=0; + if (k!=m) { + p=h[k-1][k-2]; + q=h[k][k-2]; + if (notlast==1) + r=h[k+1][k-2]; + else + r=0.0; + x=fabs(p)+fabs(q)+fabs(r); + if (x==0.0) + goto L233; + p/=x; + q/=x; + r/=x; + } /* if */ + s=sqrt(p*p+q*q+r*r); + if (p<0) + s=-s; + if (k!=m) + h[k-1][k-2]=-s*x; + else + if (l!=m) + h[k-1][k-2]=-h[k-1][k-2]; + p+=s; + x=p/s; + y=q/s; + z=r/s; + q/=p; + r/=p; + + for(j=k; j<=n; j++) { + p=h[k-1][j-1]+q*h[k][j-1]; + if (notlast==1) { + p+=r*h[k+1][j-1]; + h[k][j-1]-=p*z; + } /* if */ + h[k][j-1]-=p*y; + h[k-1][j-1]-=p*x; + } /* for j */ + if ((k+3)0.0) { + if (p<0.0) + z=p-z; + else + z+=p; + wr[na-1]=x+z; + s=x-w/z; + wr[en-1]=s; + wi[na-1]=0.0; + wi[en-1]=0.0; + x=h[en-1][na-1]; + r=sqrt(x*x+z*z); + p=x/r; + q=z/r; + for(j=na; j<=n; j++) { + z=h[na-1][j-1]; + h[na-1][j-1]=q*z+p*h[en-1][j-1]; + + /* h[en-1][j-1]=q*h[en-1][j-1]-p*z */ + h[en-1][j-1]*=q; + h[en-1][j-1]-=p*z; + } /* for j */ + for(i=1; i<=en; i++) { + z=h[i-1][na-1]; + h[i-1][na-1]=q*z+p*h[i-1][en-1]; + + /* h[i-1][en-1]=q*h[i-1][en-1]-p*z */ + h[i-1][en-1]*=q; + h[i-1][en-1]-=p*z; + } /* for i */ + for(i=low; i<=upp; i++) { + z=vecs[i-1][na-1]; + vecs[i-1][na-1]=q*z+p*vecs[i-1][en-1]; + + /* vecs[i-1][en-1]=q*vecs[i-1][en-1]-p*z */ + vecs[i-1][en-1]*=q; + vecs[i-1][en-1]-=p*z; + } /* for i */ + } /* if */ + else { + wr[na-1]=x+p; + wr[en-1]=x+p; + wi[na-1]=z; + wi[en-1]=-z; + } /* else */ + en-=2; + goto L210; + + L260: + norm=0.0; + k=1; + for(i=1; i<=n; i++) { + for(j=k; j<=n; j++) + norm+=fabs(h[i-1][j-1]); + k=i; + } /* for i */ + + for(en=n; en>=1; en--) { + p=wr[en-1]; + q=wi[en-1]; + na=en-1; + if (q==0.0) { + m=en; + h[en-1][en-1]=1.0; + for(i=na; i>=1; i--) { + w=h[i-1][i-1]-p; + r=h[i-1][en-1]; + for(j=m; j<=na; j++) + r+=h[i-1][j-1]*h[j-1][en-1]; + if (wi[i-1]<0.0) { + z=w; + s=r; + } /* if */ + else { + m=i; + if (wi[i-1]==0.0) { + if (w!=0.0) + h[i-1][en-1]=-r/w; + else + h[i-1][en-1]=-r/macheps/norm; + } else { + x=h[i-1][i]; + y=h[i][i-1]; + q=pow(wr[i-1]-p, 2.0)+wi[i-1]*wi[i-1]; + t=(x*s-z*r)/q; + h[i-1][en-1]=t; + if (fabs(x)>fabs(z)) + h[i][en-1]=(-r-w*t)/x; + else + h[i][en-1]=(-s-y*t)/z; + } /* else */ + } /* else */ + } /* i */ + } else + if (q<0.0) { + m=na; + if (fabs(h[en-1][na-1])>fabs(h[na-1][en-1])) { + h[na-1][na-1]=-(h[en-1][en-1]-p)/h[en-1][na-1]; + h[na-1][en-1]=-q/h[en-1][na-1]; + } /* if */ + else { + ComplexAssign(-h[na-1][en-1], 0.0, &c1); + ComplexAssign(h[na-1][na-1]-p, q, &c2); + ComplexDiv(c1, c2, &c3); + h[na-1][na-1]=c3.re; + h[na-1][en-1]=c3.im; + } /* else */ + h[en-1][na-1]=1.0; + h[en-1][en-1]=0.0; + for(i=(na-1); i>=1; i--) { + w=h[i-1][i-1]-p; + ra=h[i-1][en-1]; + sa=0.0; + for(j=m; j<=na; j++) { + ra+=h[i-1][j-1]*h[j-1][na-1]; + sa+=h[i-1][j-1]*h[j-1][en-1]; + } /* for j */ + if (wi[i-1]<0.0) { + z=w; + r=ra; + s=sa; + } /* if */ + else { + m=i; + if (wi[i-1]==0.0) { + ComplexAssign(-ra, -sa, &c1); + ComplexAssign(w, q, &c2); + ComplexDiv(c1, c2, &c3); + h[i-1][na-1]=c3.re; + h[i-1][en-1]=c3.im; + } /* if */ + else { + x=h[i-1][i]; + y=h[i][i-1]; + vr=pow(wr[i-1]-p, 2.0)+wi[i-1]*wi[i-1]-q*q; + vi=(wr[i-1]-p)*2.0*q; + if ((vr==0.0) && (vi==0.0)) + vr=macheps*norm*(fabs(w)+fabs(q)+fabs(x)+fabs(y)+fabs(z)); + ComplexAssign(x*r-z*ra+q*sa, x*s-z*sa-q*ra, &c1); + ComplexAssign(vr, vi, &c2); + ComplexDiv(c1, c2, &c3); + h[i-1][na-1]=c3.re; + h[i-1][en-1]=c3.im; + if (fabs(x)>(fabs(z)+fabs(q))) { + h[i][na-1]=(-ra-w*h[i-1][na-1]+q*h[i-1][en-1])/x; + h[i][en-1]=(-sa-w*h[i-1][en-1]-q*h[i-1][na-1])/x; + } /* if */ + else { + ComplexAssign(-r-y*h[i-1][na-1], -s-y*h[i-1][en-1], + &c1); + ComplexAssign(z, q, &c2); + ComplexDiv(c1, c2, &c3); + h[i][na-1]=c3.re; + h[i][en-1]=c3.im; + } /* else */ + } /* else */ + } /* else */ + } /* for i */ + } /* if */ + } /* for en */ + + for(i=1; i<=(low-1); i++) + for(j=(i+1); j<=n; j++) + vecs[i-1][j-1]=h[i-1][j-1]; + for(i=(upp+1); i<=n; i++) + for(j=(i+1); j<=n; j++) + vecs[i-1][j-1]=h[i-1][j-1]; + + for(j=n; j>=low; j--) { + if (j<=upp) + m=j; + else + m=upp; + l=j-1; + if (wi[j-1]<0.0) { + for(i=low; i<=upp; i++) { + y=z=0.0; + for(k=low; k<=m; k++) { + y+=vecs[i-1][k-1]*h[k-1][l-1]; + z+=vecs[i-1][k-1]*h[k-1][j-1]; + } /* for k */ + vecs[i-1][l-1]=y; + vecs[i-1][j-1]=z; + } /* for i */ + } /* if */ + else + if (wi[j-1]==0.0) + for(i=low; i<=upp; i++) { + z=0.0; + for(k=low; k<=m; k++) + z+=vecs[i-1][k-1]*h[k-1][j-1]; + vecs[i-1][j-1]=z; + } /* for i */ + } /* for j */ + + L270: + dummy=0; +} /* hqr2 */ + +void Eigen(int n, int ref, double **AJAC, int maxit, double eps, + int fixedref, Complex *values, Complex **vectors) { + + double *wr, *wi, *bald, **T, **A; + int i, j, ballow, balhi, max, block; + int *intout; + int fail; + + intout=IntVectorAlloc(n); + wr=VectorAlloc(n); + wi=VectorAlloc(n); + bald=VectorAlloc(n); + T=MatrixAlloc(n); + A=MatrixAlloc(n); + + for(i=1; i<=n; i++) + for(j=1; j<=n; j++) + A[i-1][j-1]=AJAC[i-1][j-1]; + + Balance(n, 10, A, &ballow, &balhi, bald); + Elmhes(n, ballow, balhi, A, intout); + Elmtrans(n, ballow, balhi, A, intout, T); + + hqr2(n, ballow, balhi, maxit, eps, A, T, wr, wi, intout, &fail); + if (fail==1) + (void) fprintf(stderr, "Failure in hqr2 function. Do not trust the given eigenvectors and -values\n"); + /* + tmxx=0; + for(i=1; i<=n; i++) + if (abs(intout[i-1])>tmxx) + tmxx=(int)ceil(abs(intout[i-1])); + */ + for(i=1; i<=n; i++) + for(j=1; j<=n; j++) + A[i-1][j-1]=0.0; + i=1; + do { + if (wi[i-1]!=0.0) { + A[i-1][i-1]=wr[i-1]; + A[i][i]=wr[i-1]; + A[i-1][i]=wi[i-1]; + A[i][i-1]=wi[i]; + i+=2; + } /* if */ + else { + A[i-1][i-1]=wr[i-1]; + i++; + } /* else */ + } while (i +#include "complex.h" + +extern void Eigen(int, int, double **, int, double, int, Complex *, Complex **); + +#endif diff --git a/Solvers/fitting.c b/Solvers/fitting.c new file mode 100644 index 0000000..f036554 --- /dev/null +++ b/Solvers/fitting.c @@ -0,0 +1,255 @@ +/*********************************************************************** + Fitting is a library of data fitting, interpolation and extrapolation + routines. + + (C) Copyright 1996 by + Kenneth Geisshirt (kneth@fatou.ruc.dk) Keld Nielsen (kn@kin.kiku.dk) + Dept. of Life Sciences and Chemistry Dept. of Theoretical Chemistry + Roskilde University University of Copenhagen + Marbjergvej 35 Universitetsparken 5 + DK-4000 Roskilde DK-2100 Copenhagen + + References: + [1] Numerical Recipes in C, 2nd edition. W.H. Press et al. + Cambridge University Press, 1992. + + Last modified: 24 March 1996 by KG +*************************************************************************/ + +#include + +#include "ssl.h" +#include "matrix.h" + +/************************************************************************* + The following routines are used inernally by this library. They are: + + * covsrt - expand the covariance matrix [1, p. 675] + +**************************************************************************/ + +void covsrt(double **covar, int ma, int *ia, int mfit) { + + int i, j, k; + double swap; + + for(i=mfit+1; i<=ma; i++) + for(j=0; j<=i; j++) covar[i-1][j-1]=covar[j-1][i-1]=0.0; + k=mfit; + for(j=ma; j>=1; j--) { + if (ia[j-1]) { + for(i=1; i<=ma; i++) SWAP(covar[i-1][k-1], covar[i-1][j-1]); + for(i=1; i<=ma; i++) SWAP(covar[k-1][i-1], covar[j-1][i-1]); + k--; + } /* if */ + } /* for j */ +} /* covsrt */ + + +/************************************************************************* + FitLine fits data to a straight line, i.e. y = ax + b. See [1, pp. 661- + 666]. +**************************************************************************/ + +void FitLine(const int N, double *x, double *y, double *sigma, + int mwt, double *a, double *b, double *asigma, + double *bsigma, double *chi2, double *q) { + + int i; + double wt, t, sxoss, sx=0.0, sy=0.0, st2=0.0, ss, sigdat; + + *b=0.0; + if (mwt) { + ss=0.0; + for(i=0; i1.01*chisq) || (iter +#include +#include "integr.h" + +double f(double x, double params[0]) { + + return sin(x); +} + +void main(void) { + + double param[0]; + + printf("Trapez (50): %2.10e\n", Trapez(50, 0.0, PI*0.5, param, &f)); + printf("Simpson (50): %2.10e\n", Simpson(50, 0.0, PI*0.5, param, &f)); + printf("Gauss5 (10): %2.10e\n", Gauss5(10, 0.0, PI*0.5, param, &f)); +} diff --git a/Solvers/inte-tes.c0 b/Solvers/inte-tes.c0 new file mode 100644 index 0000000..28755ea --- /dev/null +++ b/Solvers/inte-tes.c0 @@ -0,0 +1,23 @@ +/*************************************************************************** + Just a small test of the integration library. + + Kenneth Geisshirt, 30 August 1994. +****************************************************************************/ + +#include +#include +#include "integr.h" + +double f(double x, double params[0]) { + + return sin(x); +} + +void main(void) { + + double param[0]; + + printf("Trapez (50): %2.10e\n", Trapez(50, 0.0, PI*0.5, param, &f)); + printf("Simpson (50): %2.10e\n", Simpson(50, 0.0, PI*0.5, param, &f)); + printf("Gauss5 (10): %2.10e\n", Gauss5(10, 0.0, PI*0.5, param, &f)); +} diff --git a/Solvers/inte-tes.c01 b/Solvers/inte-tes.c01 new file mode 100644 index 0000000..28755ea --- /dev/null +++ b/Solvers/inte-tes.c01 @@ -0,0 +1,23 @@ +/*************************************************************************** + Just a small test of the integration library. + + Kenneth Geisshirt, 30 August 1994. +****************************************************************************/ + +#include +#include +#include "integr.h" + +double f(double x, double params[0]) { + + return sin(x); +} + +void main(void) { + + double param[0]; + + printf("Trapez (50): %2.10e\n", Trapez(50, 0.0, PI*0.5, param, &f)); + printf("Simpson (50): %2.10e\n", Simpson(50, 0.0, PI*0.5, param, &f)); + printf("Gauss5 (10): %2.10e\n", Gauss5(10, 0.0, PI*0.5, param, &f)); +} diff --git a/Solvers/inte-test.c b/Solvers/inte-test.c new file mode 100644 index 0000000..28755ea --- /dev/null +++ b/Solvers/inte-test.c @@ -0,0 +1,23 @@ +/*************************************************************************** + Just a small test of the integration library. + + Kenneth Geisshirt, 30 August 1994. +****************************************************************************/ + +#include +#include +#include "integr.h" + +double f(double x, double params[0]) { + + return sin(x); +} + +void main(void) { + + double param[0]; + + printf("Trapez (50): %2.10e\n", Trapez(50, 0.0, PI*0.5, param, &f)); + printf("Simpson (50): %2.10e\n", Simpson(50, 0.0, PI*0.5, param, &f)); + printf("Gauss5 (10): %2.10e\n", Gauss5(10, 0.0, PI*0.5, param, &f)); +} diff --git a/Solvers/integr.c b/Solvers/integr.c new file mode 100644 index 0000000..49f8274 --- /dev/null +++ b/Solvers/integr.c @@ -0,0 +1,111 @@ +/**************************************************************************** + This is a small library for integrating functions. + + All the integration routines assume that the integrand has the form + double f(double x, double *params) + where x is the independent variable and params is a vector of parameters. + + CopyWrong 1994 by + Kenneth Geisshirt (kneth@osc.kiku.dk) + Department of Theoretical Chemistry + H.C. Orsted Institute + Universitetsparken 5 + 2100 Copenhagen + Denmark + + References: + [1] Numerical Analysis. + D. Kincaid, and W. Cheney, Brooks/Cole, 1991. + + + Last updated: 30 August 1994 +******************************************************************************/ + +#include "integr.h" +#include + +/***************************************************************************** + Gauss5 is a five-point Gauss quadrature, [1, pp.456-462]. The argument n + is the number of subintervals. +******************************************************************************/ + +double Gauss5(int n, double a, double b, double *params, + double (*f)(double, double *)) { + + const double x_0 = 0.0; + const double x_1 = 0.538469310105683; + const double x_2 = 0.906179845938664; + const double w_0 = 0.568888888888889; + const double w_1 = 0.478628670499366; + const double w_2 = 0.236926885056189; + + double u, v, S, inte, h; + int i; + + h=(b-a)/((double) n); + inte=0.0; + + for(i=0; i<=(n-1); i++) { + u=(h*x_0+((double) 2*i+1)*h)*0.5; + S=w_0*f(u, params); + u=(h*x_1+((double) 2*i+1)*h)*0.5; + v=(-h*x_1+((double) 2*i+1)*h)*0.5; + S+=w_1*(f(u, params)+f(v, params)); + u=(h*x_2+((double) 2*i+1)*h)*0.5; + v=(-h*x_2+((double) 2*i+1)*h)*0.5; + S+=w_2*(f(u, params)+f(v, params)); + S*=h*0.5; + inte+=S; + } /* for i */ + return inte; +} /* Gauss5 */ + + +/***************************************************************************** + Trapez is using the trapeziod rule in order to evaluate the integral, + [1, pp. 445-446]. + + The parameter n is the number of subintervals. +******************************************************************************/ + +double Trapez(int n, double a, double b, double *params, + double (*f)(double, double *)) { + + int i; /* counter */ + double h; /* length of subinterval */ + double sum; /* temporary real */ + double x; /* counter */ + + h=(b-a)/((double) n); /* find subintervals */ + sum=f(a, params)+f(b, params); /* init. */ + x=a+h; + for(i=1; i<=(n-1); i++) { + sum+=2.0*f(x, params); + x+=h; + } /* for i */ + sum*=0.5*h; + return sum; +} /* Trapez */ + + +/***************************************************************************** + Simpson is computing the integral by applying composite Simpson's rule, + [1, pp. 447-448]. +******************************************************************************/ + +double Simpson(int n, double a, double b, double *params, + double (*f)(double, double *)) { + + int i; /* counter */ + double h; /* length of subintervals */ + double sum; /* sum so far */ + + h=(b-a)/((double) n); + sum=f(a, params)+f(b, params); + for(i=2; i<=n/2; i++) + sum+=2.0*f(a+((double)2*i-2)*h, params); + for(i=1; i<=n/2; i++) + sum+=4.0*f(a+((double)2*i-1)*h, params); + sum*=h/3.0; + return sum; +} /* Simpson */ diff --git a/Solvers/integr.h b/Solvers/integr.h new file mode 100644 index 0000000..1590b17 --- /dev/null +++ b/Solvers/integr.h @@ -0,0 +1,25 @@ +/**************************************************************************** + This is a small library for integrating functions. + Documentation and references are found in integr.c. + + CopyWrong 1994 by + Kenneth Geisshirt (kneth@osc.kiku.dk) + Department of Theoretical Chemistry + H.C. Orsted Institute + Universitetsparken 5 + 2100 Copenhagen + Denmark + + Last updated: 30 August 1994 +******************************************************************************/ + +#ifndef _INTEGR_LIB_ +#define _INTEGR_LIB_ + +extern double Gauss5(int, double, double, double *, + double (*f)(double, double *)); +extern double Trapez(int, double, double, double *, + double (*f)(double, double *)); +extern double Simpson(int, double, double, double *, + double (*f)(double, double *)); +#endif diff --git a/Solvers/kgadi.c b/Solvers/kgadi.c new file mode 100644 index 0000000..309f1a9 --- /dev/null +++ b/Solvers/kgadi.c @@ -0,0 +1,601 @@ +/***************************************************************************** + This is a solver of equations like + + dc / d^2c d^2c \ + -- = f(c) + D| ---- + ---- | + dt \ dx^2 dy^2 / + + where the boundary conditions are either periodic or no-flux. + + An Altenating Direction Implicit method is used to integrate + the spatial variables, [1] p. 855, and a 4th order Runge-Kutta, + [1] p. 711, or Calahan's method [4] is used to integrate the + reaction terms (f), [1] p. 711. The linear equations are solved + by a cyclic tridiagonal solver, [1] p. 74 or by Gauss-Seidel, [5] + p. 356. The linear equations in Calahan are solved by a simple + LU-decomposition, [1] p. 44. + + The different solvers are specified by lines in the input file macros. The + line ODEsolve detemines which ODE solver to be used: + 1 - 4th order Runge-Kutta. + 2 - Calahan's method. + The line LINsolve determines which solver to use in the ADI part: + 1 - Cyclic tridiagonal. + 2 - Gauss-Seidel. + The boundary conditions are specified in the input by the line BOUNDARY, + which can take the following values: + 1 - Periodic. + 2 - No flux. + + I have assumed throughout the program, that n_grids == m_grids, i.e. + a square lattice. + + Compilation is done by the command (on HP-UX): + cc -Aa +O3 -o KGadi KGadi.c model.c -lm + Note that the +O3 option can differ from system to system. But option + -O should be usable on all systems. + + CopyWrong, November/December 1993 by + Kenneth Geisshirt (kneth@osc.kiku.dk) + Department of Theoretical Chemistry + H. C. Orsted Institute + Universitetsparken 5 + 2100 Copenhagen + + Literature: + + [1] Numerical Recipes in C, 2. edition + W. H. Press et al. + [2] User's Manual to Kinetic Compiler v0.25 + K. Geisshirt. + [3] Programmer's Reference Manual to Kinetic Compiler v0.25 + K. Geisshirt. + [4] Proc. IEEE, April 1968, p. 744 + D. A. Calahan. + [5] Matrix Computations, 1. edition + G. H. Golub et al. +*****************************************************************************/ + +#include +#include "model.h" /* the model is defined in this file, see [2-3]. */ + +#define MAX_ITER 150 +#define EPS 1e-10 + +double u[n_grids][m_grids][equa]; /* concentrations */ +double max_t, dt, ptime1, ptime2, period; /* time variables */ +double R[equa]; +double dx, L; /* space variable */ +char prefix[25]; +double f[n_grids][n_grids][equa]; /* res. from RK */ +double u_new[n_grids][n_grids][equa]; /* temp. results */ +double A[n_grids][n_grids]; + +int ODEsolver, LINsolver, BOUNDARY; /* modes */ + +/***************************************************************************** +Index implements a cyclic structure. +*****************************************************************************/ + +int Index(int ind) { + + if (ind<0) return (ind+n_grids); + else if (ind>=n_grids) return (ind-n_grids); + else return ind; +} /* Index */ + + +/*************************************************************************** + The following routines are taken from [1], but modified by the + author. +***************************************************************************/ + +/* (C) Copr. 1986-92 Numerical Recipes Software +,. */ + +void tridag(double a[], double b[], double c[], double r[], + double u[], int n) { + + int j; + double bet, gam[n_grids]; + + if (b[0] == 0.0) fprintf(stderr, "Error 1 in tridag"); + u[0]=r[0]/(bet=b[0]); + for (j=2;j<=n_grids;j++) { + gam[j-1]=c[j-2]/bet; + bet=b[j-1]-a[j-1]*gam[j-1]; + if (bet == 0.0) fprintf(stderr, "Error 2 in tridag"); + u[j-1]=(r[j-1]-a[j-1]*u[j-2])/bet; + } + for (j=(n_grids-1);j>=1;j--) + u[j-1] -= gam[j]*u[j]; +} + +void cyclic(double a[], double b[], double c[], + double alpha, double beta, double r[], double x[], + int n) { + + int i; + double fact, gamma, bb[n_grids], u[n_grids], z[n_grids]; + + if (n <= 2) fprintf(stderr, "n too small in cyclic\n"); + gamma = -b[0]; + bb[0]=b[0]-gamma; + bb[n_grids-1]=b[n_grids-1]-alpha*beta/gamma; + for (i=2;i big) big=temp; + if (big == 0.0) fprintf(stderr, "Singular matrix in routine ludcmp\n"); + vv[i-1]=1.0/big; + } + for (j=1;j<=n;j++) { + for (i=1;i= big) { + big=dum; + imax=i; + } + } + if (j != imax) { + for (k=1;k<=n;k++) { + dum=a[imax-1][k-1]; + a[imax-1][k-1]=a[j-1][k-1]; + a[j-1][k-1]=dum; + } + *d = -(*d); + vv[imax-1]=vv[j-1]; + } + indx[j-1]=imax; + if (a[j-1][j-1] == 0.0) a[j-1][j-1]=TINY; + if (j != n) { + dum=1.0/(a[j-1][j-1]); + for (i=j+1;i<=n;i++) a[i-1][j-1] *= dum; + } + } +} + +void lubksb(double a[equa][equa], int n, int indx[equa], double b[equa]) { + + int i,ii=0,ip,j; + double sum; + + for (i=1;i<=n;i++) { + ip=indx[i-1]; + sum=b[ip-1]; + b[ip-1]=b[i-1]; + if (ii) + for (j=ii;j<=i-1;j++) sum -= a[i-1][j-1]*b[j-1]; + else if (sum) ii=i; + b[i-1]=sum; + } + for (i=n;i>=1;i--) { + sum=b[i-1]; + for (j=i+1;j<=n;j++) sum -= a[i-1][j-1]*b[j-1]; + b[i-1]=sum/a[i-1][i-1]; + } +} + +/************************************************************************** + L_inf distance is implemented by the next function. +**************************************************************************/ + +double Dist(double x[n_grids], double y[n_grids]) { + + int i; + double temp=0.0; + + for(i=0; i=EPS) && (iter<=MAX_ITER)); +} /* GaussSeidel */ + + + +/************************************************************************** + RungeKutta implements a 4th order Runge-Kutta method. The routines takes + x as input. The variable x is the concentrations in each point in the + mesh. The new (estimated) concentrations are stored in the variable + f. The parameter h is the time step. +***************************************************************************/ + +void RungeKutta(double x[n_grids][m_grids][equa], + double f[n_grids][m_grids][equa] , double h) { + + double k1[equa], k2[equa], k3[equa], k4[equa]; + double temp[equa], temp1[equa], temp2[equa], temp3[equa]; + int i, j, l; + + for(i=0; i=ptime1) && (t<=ptime2)) { + for(l=0; l +#include "model.h" /* the model is defined in this file, see [2-3]. */ + +#define MAX_ITER 150 +#define EPS 1e-10 + +double u[n_grids][m_grids][equa]; /* concentrations */ +double max_t, dt, ptime1, ptime2, period; /* time variables */ +double R[equa]; +double dx, L; /* space variable */ +char prefix[25]; +double f[n_grids][n_grids][equa]; /* res. from RK */ +double u_new[n_grids][n_grids][equa]; /* temp. results */ +double A[n_grids][n_grids]; + +int ODEsolver, LINsolver, BOUNDARY; /* modes */ + +/***************************************************************************** +Index implements a cyclic structure. +*****************************************************************************/ + +int Index(int ind) { + + if (ind<0) return (ind+n_grids); + else if (ind>=n_grids) return (ind-n_grids); + else return ind; +} /* Index */ + + +/*************************************************************************** + The following routines are taken from [1], but modified by the + author. +***************************************************************************/ + +/* (C) Copr. 1986-92 Numerical Recipes Software +,. */ + +void tridag(double a[], double b[], double c[], double r[], + double u[], int n) { + + int j; + double bet, gam[n_grids]; + + if (b[0] == 0.0) fprintf(stderr, "Error 1 in tridag"); + u[0]=r[0]/(bet=b[0]); + for (j=2;j<=n_grids;j++) { + gam[j-1]=c[j-2]/bet; + bet=b[j-1]-a[j-1]*gam[j-1]; + if (bet == 0.0) fprintf(stderr, "Error 2 in tridag"); + u[j-1]=(r[j-1]-a[j-1]*u[j-2])/bet; + } + for (j=(n_grids-1);j>=1;j--) + u[j-1] -= gam[j]*u[j]; +} + +void cyclic(double a[], double b[], double c[], + double alpha, double beta, double r[], double x[], + int n) { + + int i; + double fact, gamma, bb[n_grids], u[n_grids], z[n_grids]; + + if (n <= 2) fprintf(stderr, "n too small in cyclic\n"); + gamma = -b[0]; + bb[0]=b[0]-gamma; + bb[n_grids-1]=b[n_grids-1]-alpha*beta/gamma; + for (i=2;i big) big=temp; + if (big == 0.0) fprintf(stderr, "Singular matrix in routine ludcmp\n"); + vv[i-1]=1.0/big; + } + for (j=1;j<=n;j++) { + for (i=1;i= big) { + big=dum; + imax=i; + } + } + if (j != imax) { + for (k=1;k<=n;k++) { + dum=a[imax-1][k-1]; + a[imax-1][k-1]=a[j-1][k-1]; + a[j-1][k-1]=dum; + } + *d = -(*d); + vv[imax-1]=vv[j-1]; + } + indx[j-1]=imax; + if (a[j-1][j-1] == 0.0) a[j-1][j-1]=TINY; + if (j != n) { + dum=1.0/(a[j-1][j-1]); + for (i=j+1;i<=n;i++) a[i-1][j-1] *= dum; + } + } +} + +void lubksb(double a[equa][equa], int n, int indx[equa], double b[equa]) { + + int i,ii=0,ip,j; + double sum; + + for (i=1;i<=n;i++) { + ip=indx[i-1]; + sum=b[ip-1]; + b[ip-1]=b[i-1]; + if (ii) + for (j=ii;j<=i-1;j++) sum -= a[i-1][j-1]*b[j-1]; + else if (sum) ii=i; + b[i-1]=sum; + } + for (i=n;i>=1;i--) { + sum=b[i-1]; + for (j=i+1;j<=n;j++) sum -= a[i-1][j-1]*b[j-1]; + b[i-1]=sum/a[i-1][i-1]; + } +} + +/************************************************************************** + L_inf distance is implemented by the next function. +**************************************************************************/ + +double Dist(double x[n_grids], double y[n_grids]) { + + int i; + double temp=0.0; + + for(i=0; i=EPS) && (iter<=MAX_ITER)); +} /* GaussSeidel */ + + + +/************************************************************************** + RungeKutta implements a 4th order Runge-Kutta method. The routines takes + x as input. The variable x is the concentrations in each point in the + mesh. The new (estimated) concentrations are stored in the variable + f. The parameter h is the time step. +***************************************************************************/ + +void RungeKutta(double x[n_grids][m_grids][equa], + double f[n_grids][m_grids][equa] , double h) { + + double k1[equa], k2[equa], k3[equa], k4[equa]; + double temp[equa], temp1[equa], temp2[equa], temp3[equa]; + int i, j, l; + + for(i=0; i=ptime1) && (t<=ptime2)) { + for(l=0; l +#include "model.h" /* the model is defined in this file, see [2-3]. */ + +#define MAX_ITER 150 +#define EPS 1e-10 + +double u[n_grids][m_grids][equa]; /* concentrations */ +double max_t, dt, ptime1, ptime2, period; /* time variables */ +double R[equa]; +double dx, L; /* space variable */ +char prefix[25]; +double f[n_grids][n_grids][equa]; /* res. from RK */ +double u_new[n_grids][n_grids][equa]; /* temp. results */ +double A[n_grids][n_grids]; + +int ODEsolver, LINsolver, BOUNDARY; /* modes */ + +/***************************************************************************** +Index implements a cyclic structure. +*****************************************************************************/ + +int Index(int ind) { + + if (ind<0) return (ind+n_grids); + else if (ind>=n_grids) return (ind-n_grids); + else return ind; +} /* Index */ + + +/*************************************************************************** + The following routines are taken from [1], but modified by the + author. +***************************************************************************/ + +/* (C) Copr. 1986-92 Numerical Recipes Software +,. */ + +void tridag(double a[], double b[], double c[], double r[], + double u[], int n) { + + int j; + double bet, gam[n_grids]; + + if (b[0] == 0.0) fprintf(stderr, "Error 1 in tridag"); + u[0]=r[0]/(bet=b[0]); + for (j=2;j<=n_grids;j++) { + gam[j-1]=c[j-2]/bet; + bet=b[j-1]-a[j-1]*gam[j-1]; + if (bet == 0.0) fprintf(stderr, "Error 2 in tridag"); + u[j-1]=(r[j-1]-a[j-1]*u[j-2])/bet; + } + for (j=(n_grids-1);j>=1;j--) + u[j-1] -= gam[j]*u[j]; +} + +void cyclic(double a[], double b[], double c[], + double alpha, double beta, double r[], double x[], + int n) { + + int i; + double fact, gamma, bb[n_grids], u[n_grids], z[n_grids]; + + if (n <= 2) fprintf(stderr, "n too small in cyclic\n"); + gamma = -b[0]; + bb[0]=b[0]-gamma; + bb[n_grids-1]=b[n_grids-1]-alpha*beta/gamma; + for (i=2;i big) big=temp; + if (big == 0.0) fprintf(stderr, "Singular matrix in routine ludcmp\n"); + vv[i-1]=1.0/big; + } + for (j=1;j<=n;j++) { + for (i=1;i= big) { + big=dum; + imax=i; + } + } + if (j != imax) { + for (k=1;k<=n;k++) { + dum=a[imax-1][k-1]; + a[imax-1][k-1]=a[j-1][k-1]; + a[j-1][k-1]=dum; + } + *d = -(*d); + vv[imax-1]=vv[j-1]; + } + indx[j-1]=imax; + if (a[j-1][j-1] == 0.0) a[j-1][j-1]=TINY; + if (j != n) { + dum=1.0/(a[j-1][j-1]); + for (i=j+1;i<=n;i++) a[i-1][j-1] *= dum; + } + } +} + +void lubksb(double a[equa][equa], int n, int indx[equa], double b[equa]) { + + int i,ii=0,ip,j; + double sum; + + for (i=1;i<=n;i++) { + ip=indx[i-1]; + sum=b[ip-1]; + b[ip-1]=b[i-1]; + if (ii) + for (j=ii;j<=i-1;j++) sum -= a[i-1][j-1]*b[j-1]; + else if (sum) ii=i; + b[i-1]=sum; + } + for (i=n;i>=1;i--) { + sum=b[i-1]; + for (j=i+1;j<=n;j++) sum -= a[i-1][j-1]*b[j-1]; + b[i-1]=sum/a[i-1][i-1]; + } +} + +/************************************************************************** + L_inf distance is implemented by the next function. +**************************************************************************/ + +double Dist(double x[n_grids], double y[n_grids]) { + + int i; + double temp=0.0; + + for(i=0; i=EPS) && (iter<=MAX_ITER)); +} /* GaussSeidel */ + + + +/************************************************************************** + RungeKutta implements a 4th order Runge-Kutta method. The routines takes + x as input. The variable x is the concentrations in each point in the + mesh. The new (estimated) concentrations are stored in the variable + f. The parameter h is the time step. +***************************************************************************/ + +void RungeKutta(double x[n_grids][m_grids][equa], + double f[n_grids][m_grids][equa] , double h) { + + double k1[equa], k2[equa], k3[equa], k4[equa]; + double temp[equa], temp1[equa], temp2[equa], temp3[equa]; + int i, j, l; + + for(i=0; i=ptime1) && (t<=ptime2)) { + for(l=0; l +#include +#include +#include + +/*************************************************************************** + The solvers for ODEs and the service routines are imported below. +****************************************************************************/ + +#include "odesolv.h" +#include "odeserv.h" + + +/*************************************************************************** + The matrix manipulating routines like linear equation solvers are all + implemented in a small library. It is imported below. + + Routines for integrating functions are also imported below. +****************************************************************************/ + +#include "matrix.h" + +/*************************************************************************** + The program has a number of global variables. Each variable has an + underscore as the last character in order to eliminate conflicts with + names in the model. + + time_ The independent variable of the ODEs + stime_ Initial value for the independent variable. Default: 0 + etime_ Final value for the independent variable. Default: 200 + dtime_ Output at equidistant points. Also functioning as the largest + possible stepsize. Default: 2.0 + htime_ Stepsize + epsr_ Relative error tolerance. Default: 1.0E-5 + epsa_ Absolute error tolerance. Default: 1.0E-15 + epse_ Extremum error tolerance. Default: 1.0E-15 + epsmin_ Relative machine precision. Default: 1.0E-16 + timenew_ New value of the independent variable before a new step of + integration is accepted. + htimenew_ New value of the stepsize before a new step of integration is + accepted. + errlim_ The ratio between the estimate of the (scaled) local truncation + error and the relative tolenrance. + If errlim_>1.0 the steplength (hstep_) is rejected otherwise + the step of integration is accepted. + thtime_ The value of the independent variable for the next output. + step_adjustment_factor + Safety factor in the calculation of a new stepsize. Default: 0.9 + order_of_method + The order of the integration method + steplimit_increase + Upper bound for the ratio of two consecutive steps. Default: 1.5 + steplimit_decrease + Lower bound for the ratio of two consecutive steps. Default: 0.5 + step_increase_factor == -1/order_of_method. + Used in the calculation of the new steplength. + errcon_ Smallest value of errlim_, [1] + htimemin_ The minimal allowed stepsize. Default: Relative machine + precision. + + solver_ Method of integration. Default: 1 + prnmode_ Mode of output. 0: Equidistant and extrema points. + 1: Only equidistant points. + Default: 0 + scaling_ Method of scaling. 0: Strict relative error [8], + 1: Scaling device in error estimate due + to Deuflhard et al., [8]. + debug_ Mode of debug: 0: No output during numerical integration. + 1: Time, steplength and values of the variables + are printed. + 2: Different control values are printed. + Extension of mode 1. + 3: Initial values of different control values are + printed. + Default: 1 + finish_ If the user interupt the program, finish_ will be set to + 1, and the program will be terminated nicely. See also the + signal handler. + pert_ Keeps track of pertubation of the differential equations. + ptime_ Time for a perturbation. + dptime_ Time between perturbations. + outfile Handler to output file. + i Simple counter. + datafilename_Name of output file. + + equa Number of differential equations. + ns_ = equa-1 Number of dependent variables in a nonautonomous + differential equations. + xnew_ New values of the dependent variables. + xerr_ Estimate of the unscaled local truncation errors for the + dependent variables. + begin_print Time for first print out. + species_ A table with the names of the independent variables. + + + The file model.c contains the C-code that depends on a specific model. + It is generated by kc, see [4]. +*****************************************************************************/ + +static double time_, stime_, etime_, dtime_, htime_, epsr_, epsa_, epse_; +static double epsmin_, timenew_, htimenew_, errlim_, thtime_, ptime_; +static double step_adjustment_factor, order_of_method, steplimit_increase; +static double steplimit_decrease, step_increase_factor, errcon_, htimemin_; +static int solver_, prnmode_, scaling_, pert_=1, i; +static double dptime_; +static double begin_print; +static FILE *outfile; +static char datafilename_[35]; +static int debug_=1, finish_=0; +static int steprejection_=0; /* Number of step rejections */ +static double cmax_, cmin_; +int nospecieserr_; /* Number of variables used in the estimate + of local error */ + +#include "model.c" + +static const int ns_ = equa-1; +static double xnew_[equa], xerr_[equa]; +static double fx_[equa], temp_[equa], xdt_[equa]; + +/**************************************************************************** + The routine UserInterrupt catch the interrupt signal from the operating + system. This signal is sent when the user wants to abort the program + before normal termination. The feature ensure that the buffers are flushed, + and the termination in general is done "nicely". The signal handler is + very simple - the actual work is done by the main program. +*****************************************************************************/ + +void UserInterrupt(int dummy) { + + finish_=1; +} /* UserInterrupt */ + + +/*************************************************************************** + PrintDebug is the debugging routine of the program. It prints the + information specified by the variable debug_. The information is printed + on the standard output. +****************************************************************************/ + +void PrintDebug(int flag_, double t1_, double ht1_, double *x1_, double t2_, + double ht2_, double *x2_,int *do_prn) { + + int i; + + switch (flag_) { + case 0: + /* do nothing */ + break; + case 1: + printf("\033\[3;1HTime: %e Steplength: %e\033\[K\n\033\[K\n", t2_, ht2_); + for(i=0; i0.0) + nsg_[i]=1; + else + nsg_[i]=0; + } /* do_prn */ + } /* for i */ + + if (*first_) { + *first_= 0; + for(i=0; iepse_) { + xmax_[i]= x_[i]; + if (flag_==0) + flag_= (-(i+1)); + } + break; + case 0: + break; + case 1: + if (fabs(xmax_[i]-x_[i])>epse_) { + xmin_[i]= x_[i]; + if (flag_==0) + flag_= (i+1); + } + break; + } /* switch */ + } /* osg != nsg */ + } /* do_prn */ + } /* for i */ + return flag_; +} /* ChangeSignVectors */ + +void DosDisplay(int mode_) { + switch(mode_) { + case 0: + printf("\033\[2J"); /* Clear display */ + printf("\033\[44;36m"); + break; + case 1: + printf("\033\[40;37m"); + break; + } /* switch */ +} /* DosDisPlay */ + +/*************************************************************************** + Main initialises the system, and it is also the driver routine for the + numerical schemes implemented. + + The idea is that each solver takes one time step, and main contains a + loop going from time=initial time to termination time. The step length + controller is implemented as part of main. +****************************************************************************/ + +void main(void) { + + double xmin_[equa], xmax_[equa], hlp_; + time_t timer_; /* time and date */ + int i, j, dyn_, csv_, prndt_, first_; + int nsg_[equa], osg_[equa]; + + /* Set up the display */ + DosDisplay(0); + + + printf("KKsoldos v%s, CopyWrong 1994-1995 by Keld Nielsen and Kenneth Geisshirt\n", VERSION_); + + + + /* Find time and date */ + timer_=time(&timer_); + + /* Set up signal handler */ + (void) signal(SIGINT, &UserInterrupt); + + /* Allocate the jacobian matrix */ + jacobi_matx=MatrixAlloc(equa); + + /* Initialization of the model dependent variables. */ + InitValues(); + + /* Initialize parameters for various printing modes */ + first_= 1; + switch (prnmode_) { + case 0: + for(i=0; ietime_) + kcerror("stime > etime"); + + /* Program aborted: If initial time is less than the zero */ + if (time_<0.0) + kcerror("stime < 0.0"); + + /* Program aborted: If initial stepsize is less than the zero */ + if (htime_<0.0) + kcerror("htime < 0.0"); + + /* Program aborted: If requested output at eqvidistant points + is not resonable */ + if (dtime_<0.0) + kcerror("dtime < 0.0"); + + /* Smallest absoulte error not less than relative machine precision */ + if (epsa_=0.5*dtime_) + htime_=0.5*dtime_; + + /* Opening output file */ + outfile=fopen(datafilename_, "w"); + fprintf(outfile, "# Output from kksolver v%s, %s", VERSION_, + ctime(&timer_)); + fprintf(outfile, "# CopyWrong 1994-1995 by Keld Nielsen and Kenneth Geisshirt\n"); + dyn_=1; + for(i=0; i=begin_print) + PrintState(nospecieserr_, prnmode_, 0, time_, x_, outfile, do_print); + + if (debug_==3) + PrintDebug(debug_, time_, htime_, x_, time_, htime_, x_, do_print); + + /* Main part of the integration algorithm */ + while ((time_etime_) + thtime_=etime_; + + if (debug_==2) + PrintDebug(debug_, time_, htime_, x_, time_+htime_, htimenew_, xnew_, do_print); + + if (errlim_>1.0) { /* The new stepsize is not accepted if the + local error estimate is larger than the + relative error tolerance */ + htime_=htimenew_; + if (steprejection_!=2) { + steprejection_++; + } else { /* If the new stepsize has been rejected more + than two times the new stepsize is drastical + reduced; h_new= h_old/10. + Method suggested by Hairer and Wanner [9] */ + steprejection_=0; + htime_= htimenew_/10.0; + } /* else */ + } else { /* The new stepsize is accepted if the local error + estimate is less or equal to the relative error + tolerance */ + timenew_=time_+htime_; + steprejection_=0; + +#ifdef _DO_PERT_ /* code for doing perturbations */ + if (timenew_=begin_print)) + PrintState(nospecieserr_, prnmode_, 2, time_, x_, outfile, + do_print); + if (prndt_) + prndt_=0; + } /* if */ + time_=timenew_; + htime_=htimenew_; + for(i=0; i=begin_print) + PrintState(nospecieserr_, prnmode_, 1, time_, x_, outfile, + do_print); + if (debug_==1) + PrintDebug(debug_, timenew_, htimenew_, xnew_, time_, htime_, x_, do_print); + } else { /* The new time exceed the time for the + next output. The differential equations + are integrated from (t) to (t+dt), and + the solution at t+dt is printed. The + integration begin again from (t+h, xnew_) */ + hlp_=thtime_-time_; + switch(solver_) { + case 1: /* Calahan */ + CalahanOneStep(equa, hlp_, x_, xdt_, &reac, &jacobi); + break; + case 2: /* GRK4T */ + GRK4T(equa, hlp_, x_, xdt_, xerr_, &reac, &jacobi); + break; + case 3: /* RKFNC */ + RKFNC(equa, hlp_, x_, xdt_, xerr_, &reac); + break; + case 4: /* RK4 */ + RK4OneStep(equa, hlp_, x_, xdt_, &reac); + break; + case 5: /* GRK4TTime */ + GRK4TTime(equa, ns_, time_, hlp_, x_, xdt_, xerr_, &reac, &jacobi); + break; + case 6: /* RKFNCTime */ + RKFNCTime(equa, ns_, time_, hlp_, x_, xdt_, xerr_, &reac); + break; + } /* switch (solver_) */ + + if (prnmode_==0) { /* Output: The extrema values */ + csv_=ChangeSignVectors(nospecieserr_, x_, xnew_, xmax_, xmin_, + osg_, nsg_, &first_, do_print); + prndt_=1; + } + if (debug_==1) + PrintDebug(debug_, time_, htime_, x_, thtime_, htime_, xdt_, do_print); + time_=thtime_; + htime_=htimenew_; + thtime_+=dtime_; + for(i=0; i=begin_print) + PrintState(nospecieserr_,prnmode_, 1,time_,x_,outfile,do_print); + } /* else */ + } /* else */ +#ifdef _DO_PERT_ /* code for doing perturbations */ + } /* ptime_>timenew_ */ + else { + if (timenew_>=ptime_) { + if (timenew_==ptime_) { + if (time_>=begin_print) + PrintState(nospecieserr_, 1, 1, time_, x_, outfile, do_print); + time_=timenew_; + htime_=htimenew_; + for(i=0; i=begin_print) + PrintState(nospecieserr_,1,1,time_,x_,outfile,do_print); + for(i=0; i=begin_print) + PrintState(nospecieserr_,1,1,time_,x_,outfile,do_print); + } /* timenew=ptime */ + + if (timenew_>ptime_) { + if (time_>=begin_print) + PrintState(nospecieserr_, 1, 1, time_, x_, outfile, do_print); + hlp_=ptime_-time_; + switch(solver_) { + case 1: /* Calahan */ + CalahanOneStep(equa, hlp_, x_, xdt_, &reac, &jacobi); + break; + case 2: /* GRK4T */ + GRK4T(equa, hlp_, x_, xdt_, xerr_, &reac, &jacobi); + break; + case 3: /* RKFNC */ + RKFNC(equa, hlp_, x_, xdt_, xerr_, &reac); + break; + case 4: /* RK4 */ + RK4OneStep(equa, hlp_, x_, xdt_, &reac); + break; + case 5: /* GRK4TTime */ + GRK4TTime(equa, ns_, time_, hlp_, x_, xdt_, xerr_, &reac, &jacobi); + break; + case 6: /* RKFNCTime */ + RKFNCTime(equa, ns_, time_, hlp_, x_, xdt_, xerr_, &reac); + break; + } /* switch (solver_) */ + time_=ptime_; + htime_=timenew_-ptime_; + if(ptime_==thtime_) { + thtime_ += dtime_; + } + for(i=0; i=begin_print) + PrintState(nospecieserr_,1,1,time_,x_,outfile,do_print); + for(i=0; i=begin_print) + PrintState(nospecieserr_,1,1,time_,x_,outfile,do_print); + } /* timenew> ptime */ + } /* else: timenew>ptime */ + + if (dptime_==0.0) { + ptime_ += etime_+1.0; + } else { + ptime_ += dptime_; + } /* dptime=0.0 */ + + /* Initialize parameters for various printing modes */ + first_= 1; + switch (prnmode_) { + case 0: + for(i=0; i=ptime */ +#endif + } /* errlim_ <= 1.0 */ + + } /* while (time_ +#include +#include +#include + +/*************************************************************************** + The solvers for ODEs and the service routines are imported below. +****************************************************************************/ + +#include "odesolv.h" +#include "odeserv.h" + + +/*************************************************************************** + The matrix manipulating routines like linear equation solvers are all + implemented in a small library. It is imported below. + + Routines for integrating functions are also imported below. +****************************************************************************/ + +#include "matrix.h" + +/*************************************************************************** + The program has a number of global variables. Each variable has an + underscore as the last character in order to eliminate conflicts with + names in the model. + + time_ The independent variable of the ODEs + stime_ Initial value for the independent variable. Default: 0 + etime_ Final value for the independent variable. Default: 200 + dtime_ Output at equidistant points. Also functioning as the largest + possible stepsize. Default: 2.0 + htime_ Stepsize + epsr_ Relative error tolerance. Default: 1.0E-5 + epsa_ Absolute error tolerance. Default: 1.0E-15 + epse_ Extremum error tolerance. Default: 1.0E-15 + epsmin_ Relative machine precision. Default: 1.0E-16 + timenew_ New value of the independent variable before a new step of + integration is accepted. + htimenew_ New value of the stepsize before a new step of integration is + accepted. + errlim_ The ratio between the estimate of the (scaled) local truncation + error and the relative tolenrance. + If errlim_>1.0 the steplength (hstep_) is rejected otherwise + the step of integration is accepted. + thtime_ The value of the independent variable for the next output. + step_adjustment_factor + Safety factor in the calculation of a new stepsize. Default: 0.9 + order_of_method + The order of the integration method + steplimit_increase + Upper bound for the ratio of two consecutive steps. Default: 1.5 + steplimit_decrease + Lower bound for the ratio of two consecutive steps. Default: 0.5 + step_increase_factor == -1/order_of_method. + Used in the calculation of the new steplength. + errcon_ Smallest value of errlim_, [1] + htimemin_ The minimal allowed stepsize. Default: Relative machine + precision. + + solver_ Method of integration. Default: 1 + prnmode_ Mode of output. 0: Equidistant and extrema points. + 1: Only equidistant points. + Default: 0 + scaling_ Method of scaling. 0: Strict relative error [8], + 1: Scaling device in error estimate due + to Deuflhard et al., [8]. + debug_ Mode of debug: 0: No output during numerical integration. + 1: Time, steplength and values of the variables + are printed. + 2: Different control values are printed. + Extension of mode 1. + 3: Initial values of different control values are + printed. + Default: 0 + finish_ If the user interupt the program, finish_ will be set to + 1, and the program will be terminated nicely. See also the + signal handler. + pert_ Keeps track of pertubation of the differential equations. + ptime_ Time for a perturbation. + dptime_ Time between perturbations. + outfile Handler to output file. + i Simple counter. + datafilename_Name of output file. + + equa Number of differential equations. + ns_ = equa-1 Number of dependent variables in a nonautonomous + differential equations. + xnew_ New values of the dependent variables. + xerr_ Estimate of the unscaled local truncation errors for the + dependent variables. + begin_print Time for first print out. + species_ A table with the names of the independent variables. + + + The file model.c contains the C-code that depends on a specific model. + It is generated by kc, see [4]. +*****************************************************************************/ + +static double time_, stime_, etime_, dtime_, htime_, epsr_, epsa_, epse_; +static double epsmin_, timenew_, htimenew_, errlim_, thtime_, ptime_; +static double step_adjustment_factor, order_of_method, steplimit_increase; +static double steplimit_decrease, step_increase_factor, errcon_, htimemin_; +static int solver_, prnmode_, scaling_, pert_=1, i; +static double dptime_; +static double begin_print; +static FILE *outfile; +static char datafilename_[35]; +static int debug_=1, finish_=0; +static int steprejection_=0; /* Number of step rejections */ +static double cmax_, cmin_; +int nospecieserr_; /* Number of variables used in the estimate + of local error */ + +#include "model.c" + +static const int ns_ = equa-1; +static double xnew_[equa], xerr_[equa]; +static double fx_[equa], temp_[equa], xdt_[equa]; + +/**************************************************************************** + The routine UserInterrupt catch the interrupt signal from the operating + system. This signal is sent when the user wants to abort the program + before normal termination. The feature ensure that the buffers are flushed, + and the termination in general is done "nicely". The signal handler is + very simple - the actual work is done by the main program. +*****************************************************************************/ + +void UserInterrupt(int dummy) { + + finish_=1; +} /* UserInterrupt */ + + +/*************************************************************************** + PrintDebug is the debugging routine of the program. It prints the + information specified by the variable debug_. The information is printed + on the standard output. +****************************************************************************/ + +void PrintDebug(int flag_, double t1_, double ht1_, double *x1_, double t2_, + double ht2_, double *x2_, int *do_prn) { + + int i; + + switch (flag_) { + case 0: + /* do nothing */ + break; + case 1: + printf("\33HTime: %e Steplength: %e\33K\n\33K\n", t2_, ht2_); + for(i=0; i0.0) + nsg_[i]=1; + else + nsg_[i]=0; + } /* do_prn */ + } /* for i */ + + if (*first_) { + *first_=0; + for(i=0; iepse_) { + xmax_[i]=x_[i]; + if (flag_==0) + flag_= (-(i+1)); + } + break; + case 0: + break; + case 1: + if (fabs(xmax_[i]-x_[i])>epse_) { + xmin_[i]=x_[i]; + if (flag_==0) + flag_= (i+1); + } /* if */ + break; + } /* switch */ + } /* osg != nsg */ + } /* do_prn */ + } /* for i */ + return flag_; +} /* ChangeSignVectors */ + +/*************************************************************************** + Main initialises the system, and it is also the driver routine for the + numerical schemes implemented. + + The idea is that each solver takes one time step, and main contains a + loop going from time=initial time to termination time. The step length + controller is implemented as part of main. +****************************************************************************/ + +void main(void) { + + double xmin_[equa], xmax_[equa], hlp_; + time_t timer_; /* time and date */ + int i, j, dyn_, csv_, prndt_, first_; + int nsg_[equa], osg_[equa]; + + + printf("KKsolver v%s, CopyWrong 1994-1996 by Keld Nielsen and Kenneth Geisshirt\n", VERSION_); + + /* Find time and date */ + timer_=time(&timer_); + + /* Set up signal handler */ + (void) signal(SIGINT, &UserInterrupt); + + /* Allocate the jacobian matrix */ + jacobi_matx=MatrixAlloc(equa); + + /* Initialization of the model dependent variables. */ + InitValues(); + + /* Initialize parameters for various printing modes */ + first_=1; + switch (prnmode_) { + case 0: + for(i=0; ietime_) + kcerror("stime > etime"); + + /* Program aborted: If initial time is less than the zero */ + if (time_<0.0) + kcerror("stime < 0.0"); + + /* Program aborted: If initial stepsize is less than the zero */ + if (htime_<0.0) + kcerror("htime < 0.0"); + + /* Program aborted: If requested output at eqvidistant points + is not resonable */ + if (dtime_<0.0) + kcerror("dtime < 0.0"); + + /* Smallest absoulte error not less than relative machine precision */ + if (epsa_=0.5*dtime_) + htime_=0.5*dtime_; + + /* Opening output file */ + outfile=fopen(datafilename_, "w"); + fprintf(outfile, "# Output from kksolver v%s, %s", VERSION_, + ctime(&timer_)); + fprintf(outfile, "# CopyWrong 1994-1995 by Keld Nielsen and Kenneth Geisshirt\n"); + dyn_=1; + for(i=0; i=begin_print) + PrintState(nospecieserr_, prnmode_, 0, time_, x_, outfile, do_print); + + if (debug_==3) + PrintDebug(debug_, time_, htime_, x_, time_, htime_, x_, do_print); + + /* Main part of the integration algorithm */ + while ((time_etime_) + thtime_=etime_; + + if (debug_==2) + PrintDebug(debug_, time_, htime_, x_, time_+htime_, htimenew_, + xnew_, do_print); + + if (errlim_>1.0) { /* The new stepsize is not accepted if the + local error estimate is larger than the + relative error tolerance */ + htime_=htimenew_; + if (steprejection_!=2) { + steprejection_++; + } else { /* If the new stepsize has been rejected more + than two times the new stepsize is drastical + reduced; h_new= h_old/10. + Method suggested by Hairer and Wanner [9] */ + steprejection_=0; + htime_= htimenew_/10.0; + } /* else */ + } else { /* The new stepsize is accepted if the local error + estimate is less or equal to the relative error + tolerance */ + timenew_=time_+htime_; + steprejection_=0; + +#ifdef _DO_PERT_ /* code for doing perturbations */ + if (timenew_=begin_print)) + PrintState(nospecieserr_, prnmode_, 2, time_, x_, outfile, + do_print); + if (prndt_) + prndt_=0; + } /* if */ + time_=timenew_; + htime_=htimenew_; + for(i=0; i=begin_print) + PrintState(nospecieserr_, prnmode_, csv_, time_, x_, outfile, + do_print); + if (debug_==1) + PrintDebug(debug_, timenew_, htimenew_, xnew_, time_, + htime_, x_, do_print); + } else { /* The new time exceed the time for the + next output. The differential equations + are integrated from (t) to (t+dt), and + the solution at t+dt is printed. The + integration begin again from (t+h, xnew_)*/ + hlp_=thtime_-time_; + switch(solver_) { + case 1: /* Calahan */ + CalahanOneStep(equa, hlp_, x_, xdt_, &reac, &jacobi); + break; + case 2: /* GRK4T */ + GRK4T(equa, hlp_, x_, xdt_, xerr_, &reac, &jacobi); + break; + case 3: /* RKFNC */ + RKFNC(equa, hlp_, x_, xdt_, xerr_, &reac); + break; + case 4: /* RK4 */ + RK4OneStep(equa, hlp_, x_, xdt_, &reac); + break; + case 5: /* GRK4TTime */ + GRK4TTime(equa, ns_, time_, hlp_, x_, xdt_, xerr_, + &reac, &jacobi); + break; + case 6: /* RKFNCTime */ + RKFNCTime(equa, ns_, time_, hlp_, x_, xdt_, xerr_, &reac); + break; + } /* switch (solver_) */ + + if (prnmode_==0) { /* Output: The extrema values */ + csv_=ChangeSignVectors(nospecieserr_, x_, xnew_, xmax_, xmin_, + osg_, nsg_, &first_, do_print); + prndt_=1; + } + if (debug_==1) + PrintDebug(debug_, time_, htime_, x_, thtime_, htime_, + xdt_, do_print); + time_=thtime_; + htime_=htimenew_; + thtime_+=dtime_; + for(i=0; i=begin_print) + PrintState(nospecieserr_, prnmode_, 1, time_, x_, + outfile, do_print); + } /* else */ + } /* else */ +#ifdef _DO_PERT_ /* code for doing perturbations */ + } /* ptime_>timenew_ */ + else { + if (timenew_>=ptime_) { + if (timenew_==ptime_) { + if (time_>=begin_print) + PrintState(nospecieserr_, 1, 1, time_, x_, outfile, do_print); + time_=timenew_; + htime_=htimenew_; + for(i=0; i=begin_print) + PrintState(nospecieserr_, 1, 1, time_, x_, outfile, do_print); + for(i=0; i=begin_print) + PrintState(nospecieserr_, 1, 1, time_, x_, outfile, do_print); + } /* timenew=ptime */ + + if (timenew_>ptime_) { + if (time_>=begin_print) + PrintState(nospecieserr_, 1, 1, time_, x_, outfile, do_print); + hlp_=ptime_-time_; + switch(solver_) { + case 1: /* Calahan */ + CalahanOneStep(equa, hlp_, x_, xdt_, &reac, &jacobi); + break; + case 2: /* GRK4T */ + GRK4T(equa, hlp_, x_, xdt_, xerr_, &reac, &jacobi); + break; + case 3: /* RKFNC */ + RKFNC(equa, hlp_, x_, xdt_, xerr_, &reac); + break; + case 4: /* RK4 */ + RK4OneStep(equa, hlp_, x_, xdt_, &reac); + break; + case 5: /* GRK4TTime */ + GRK4TTime(equa, ns_, time_, hlp_, x_, xdt_, xerr_, + &reac, &jacobi); + break; + case 6: /* RKFNCTime */ + RKFNCTime(equa, ns_, time_, hlp_, x_, xdt_, xerr_, &reac); + break; + } /* switch (solver_) */ + time_=ptime_; + htime_=timenew_-ptime_; + if(ptime_==thtime_) + thtime_ += dtime_; + for(i=0; i=begin_print) + PrintState(nospecieserr_, 1, 1, time_, x_, outfile, do_print); + for(i=0; i=begin_print) + PrintState(nospecieserr_, 1, 1, time_, x_, outfile, do_print); + } /* timenew> ptime */ + } /* else: timenew>ptime */ + + if (dptime_==0.0) { + ptime_+=etime_+1.0; + } else { + ptime_+=dptime_; + } /* dptime=0.0 */ + + /* Initialize parameters for various printing modes */ + first_=1; + switch (prnmode_) { + case 0: + for(i=0; i=ptime */ +#endif + } /* errlim_ <= 1.0 */ + + } /* while (time_ +#include "matrix.h" + +void main(void) { + + double **A; + double *vec, *x; + int *index, i; + + A=MatrixAlloc(3); + printf("A allocated\n"); + + vec=VectorAlloc(3); + printf("vec allocated\n"); + + x=VectorAlloc(3); + printf("x allocated\n"); + + index=IntVectorAlloc(3); + printf("index allocated\n"); + + A[0][0]=-1.0; A[0][1]=1.0; A[0][2]=-4.0; + A[1][0]=2.0; A[1][1]=2.0; A[1][2]=0.0; + A[2][0]=3.0; A[2][1]=3.0; A[2][2]=2.0; + + vec[0]=0.0; vec[1]=1.0; vec[2]=0.5; + + LUfact(3, A, index); + printf("LUfact\n"); + + LUsubst(3, A, index, vec); + printf("LUsubst\n"); + + printf("vec = (%e, %e, %e)\n", vec[0], vec[1], vec[2]); + + A[0][0]=1.0; A[0][1]=0.5; A[0][2]=1.0/3.0; + A[1][0]=1.0/3.0; A[1][1]=1.0; A[1][2]=0.5; + A[2][0]=0.5; A[2][1]=1.0/3.0; A[2][2]=1.0; + + vec[0]=11.0/18.0; vec[1]=11.0/18.0; vec[2]=11.0/18.0; + x[0]=0.0; x[1]=0.0; x[2]=0.0; + + GaussSeidel(3, A, vec, x, 1.0e-10, 100); + printf("Gauss-Seidel\n"); + + printf("x = (%e, %e, %e)\n", x[0], x[1], x[2]); + + A[0][0]=1.0; A[0][1]=0.5; A[0][2]=1.0/3.0; + A[1][0]=1.0/3.0; A[1][1]=1.0; A[1][2]=0.5; + A[2][0]=0.5; A[2][1]=1.0/3.0; A[2][2]=1.0; + + vec[0]=11.0/18.0; vec[1]=11.0/18.0; vec[2]=11.0/18.0; + x[0]=0.0; x[1]=0.0; x[2]=0.0; + + Jacobi(3, A, vec, x, 1.0e-10, 100); + printf("Jacobi\n"); + + printf("x = (%e, %e, %e)\n", x[0], x[1], x[2]); + + A[0][0]=1.0; A[0][1]=0.5; A[0][2]=1.0/3.0; + A[1][0]=1.0/3.0; A[1][1]=1.0; A[1][2]=0.5; + A[2][0]=0.5; A[2][1]=1.0/3.0; A[2][2]=1.0; + + GSR(3, A); + printf("GSR\n"); + + for(i=0; i<3; i++) + printf("%e %e %e\n", A[i][0], A[i][1], A[i][2]); + + MatrixFree(3, A); + printf("A freed\n"); + + VectorFree(3, vec); + printf("vec freed\n"); + + VectorFree(3, x); + printf("x freed\n"); + + IntVectorFree(3, index); + printf("index freed\n"); +} + diff --git a/Solvers/matrix.c b/Solvers/matrix.c new file mode 100644 index 0000000..d3412bd --- /dev/null +++ b/Solvers/matrix.c @@ -0,0 +1,612 @@ +/**************************************************************************** + Misc. routines for manipulating matrices and vectors. + + The matrices and vectors are indexed in C-style, i.e. from 0 to + N-1. A matrix is assumed to be declared as double **, and it is + allocated by MatrixAlloc. + + + CopyWrong 1994-1995 by + Kenneth Geisshirt (kneth@fatou.ruc.dk) + Department of Life Sciences and Chemistry + Roskilde University + P.O. Box 260 + 4000 Roskilde + Denmark + + + References: + [1] Numerical Recipes in C, 2nd edition, + W.H. Press, S.A. Teukolsky, W.T. Vitterling, and B.P. Flannery, + Cambridge University Press, 1992. + [2] Numerical Analysis, + D. Kincaid and W. Cheney, + Brooks/Cole Publishing Company, 1991. + [3] The C Programming Language, 2nd edition, + B.W. Kernighan and D.M. Ritchie, + Prentice Hall, 1988. + [4] Advanced Engineering Mathematics, 6th edition, + E. Kreyszig, + Wiley and Sons, 1988. + + + Last updated: 9 May 1995 by KN +*****************************************************************************/ + +#include +#include + +#ifndef TINY +# define TINY 1.0e-18 +#endif + +#include "matrix.h" + +/***************************************************************************** + MatrixAlloc allocates storage for a square matrix with dimension + n*n. An error message is printed, if it was impossible to allocate + the neccesary space, [3]. +*****************************************************************************/ + +double **MatrixAlloc(const int n) { + + double **matrix; + int i; + + matrix=(double **)calloc(n, sizeof(double *)); + if (matrix==NULL) + fprintf(stderr, "In MatrixLib: Not able to allocate matrix.\n"); + else + for(i=0; i=k so ... */ + not_finished=1; + while (not_finished) { + j++; + temp=fabs(a[p[j]][k]/s[p[j]]); + for(i=k; i=(fabs(a[p[i]][k])/s[p[i]])) + not_finished=0; /* end loop */ + } /* while */ + i_swap=p[k]; + p[k]=p[j]; + p[j]=i_swap; + temp=1.0/a[p[k]][k]; + for(i=(k+1); i=0; i--) { /* back subst */ + sum=b[p[i]]; + for(j=(i+1); j=k so ... */ + not_finished=1; + while (not_finished) { + j++; + temp=fabs(A_fixed[p_fixed[j]][k]/s_fixed[p_fixed[j]]); + for(i=k; i=(fabs(A_fixed[p_fixed[i]][k])/s_fixed[p_fixed[i]])) + not_finished=0; /* end loop */ + } /* while */ + i_swap=p_fixed[k]; + p_fixed[k]=p_fixed[j]; + p_fixed[j]=i_swap; + temp=1.0/A_fixed[p_fixed[k]][k]; + for(i=(k+1); i=0; i--) { /* back subst */ + sum=b[p_fixed[i]]; + for(j=(i+1); j=0; i--) + x[i]=(b[i]-c[i]*b[i+1])/d[i]; + + for(i=0; i=eps)); + + VectorFree(n, x_old); +} /* GaussSeidel */ + + +/***************************************************************************** + Jacobi is an iterative equation solver, [2, pp. 185-189]. The algorithm + can be optimised a bit, which is done in this implementation. The method + is suitable for parallel computers. + + The arguments are the same as in GaussSeidel. +*****************************************************************************/ + +void Jacobi(const int n, double **a, double *b, double *x, double eps, + int max_iter) { + + double d; /* temporary real */ + int i, j, iter; /* counters */ + double **a_new; /* a is altered */ + double *b_new; /* b is altered */ + double *u; /* new solution */ + double norm; /* L1-norm */ + + a_new=MatrixAlloc(3); + b_new=VectorAlloc(3); + u=VectorAlloc(3); + + for(i=0; i=eps)); + + MatrixFree(3, a_new); + VectorFree(3, b_new); + VectorFree(3, u); +} /* Jacobi */ + + +/**************************************************************************** + DotProd computes the dot product between two vectors. They are assumed to + be of the same dimension. +*****************************************************************************/ + +double DotProd(const int n, double *u, double *v) { + + int i; /* counter */ + double sum=0.0; /* temporary real */ + + for(i=0; i */ + for(i=0; i + + + +/********************************************************************* + NewtonRaphson1D is the Newton-Raphson method for functions on the + real axis, [1, pp. 362-367]. + + Parameters: + x0 - initial guess of the solution + f - the function + df - the derivative of the function + eps - accuratecy of the solution + max_iter - the maximal number of iterations +**********************************************************************/ + +double NewtonRaphson1D(double x0, double (*f)(double), double (*df)(double), + double eps, int max_iter) { + + int iter; /* number of iterations */ + double x_new, x_old; + double norm; + + x_new=x_old=x0; + iter=0; + do { + iter++; + x_old=x_new; + x_new-=f(x_old)/df(x_old); + norm=fabs(x_new-x_old); + } while ((norm>=eps) || (itereps) && (iter +#include +#include + +/**************************************************************************** + The service routines are: + + o kcerror - prints an error message and aborts the program. + o FindMachEps - find the machine's precision + o MaxVec - find the (abs) largest number in a vector + o MaxPair - find the largest of two numbers + o MinPair - find the smallest of two numbers + o PrintState - print the independent variable (time_) and the dependent + variables (x_). The data is written to the disk. The file + handler is outfile. The output is in ASCII characters, and + can be found in the following way: + time_ x_[0] x_[1] ... x_[equa-1] x_[equa] + Three modes of output. prnmode_=0: Equidistant and extrema + points printed, and prnmode_=1: Only equidistant points. + Default: 0. + o BSort - Bubble sort. The sorted list is a vector of real numbers, + [11, p. 157]. + o KronDelta - Kronecker delta. +*****************************************************************************/ + +void kcerror(char *str) { + + fprintf(stderr, "Failure in numerical integration: %s.\n", str); + fprintf(stderr, "Aborting the program - sorry.\n"); + exit(-1); +} /* kcerror */ + + +double FindMachEps(void) { + + double temp=1.0; + + while ((1.0+temp)!=1.0) + temp/=10.0; + return temp; +} /* FindMachEps */ + + +double MaxVec(int nosp_, double *x_) { + + double temp1_=0.0, temp2_; + int i_; + + for(i_=0; i_temp1_) + temp1_=temp2_; + } /* for i_ */ + return temp1_; +} /* MaxVec */ + + +double MaxPair(double x_, double y_) { + + if (x_>y_) + return x_; + else + return y_; +} /* MaxPair */ + + +double MinPair(double x_, double y_) { + + if (x_ + +extern void kcerror(char *); +extern double FindMachEps(void); +extern double MaxVec(int, double *); +extern double MaxPair(double, double); +extern double MinPair(double, double); +extern void PrintState(int, int, int, double, double *, FILE *, int *); +extern void BSort(const int, double *); +extern double KronDelta(int, int); +#endif + + diff --git a/Solvers/odesolv.c b/Solvers/odesolv.c new file mode 100644 index 0000000..eff79fd --- /dev/null +++ b/Solvers/odesolv.c @@ -0,0 +1,636 @@ +/*************************************************************************** + This source file contains various numerical solvers for ordinary + differential equations. + + The routines associated by each solver compute one and only one time + step. + + Please see the file kksolver.c for all the details. The file is also + an example of how this library can be used. + + + CopyWrong 1994-1995 by + Kenneth Geisshirt (kneth@fatou.ruc.dk) + Department of Life Sciences and Chemistry + Roskilde University + P.O. Box 260 + 4000 Roskilde + Denmark + + and + Keld Nielsen (kn@osc.kiku.dk) + Department of Theoretical Chemistry + H.C. Orsted Institute + Universitetsparken 5 + 2100 Copenhagen + Denmark + + + References: + [1] W.H. Press, et al. Numerical Recipes in C, 2. edition. + Cambridge University Press, 1992. + [2] D.A. Calahan. (1968). Proc. IEEE, April 1968, p. 744. + [3] P. Kaps, and P. Rentrop. (1979). Numer. Math, 33, pp. 55-68. + [4] K. Geisshirt. Chemical Waves in Reaction-Diffusion Systems: A Numerical + Study. (M.Sc. thesis, University of Copenhagen), 1994. + [5] M. Kubicek, and M. Marek, Computational Methods In Bifucation Theory + And Dissipative Structures, Springer-Verlag, New York, 1983. + [6] J.R. Cash, and A.H. Karp. (1990). ACM Trans. Math. Softw. 16, + pp. 201-222. + [7] P. Kaps, S.W.H. Poon, and T.D. Bui. (1985). Computing. 34, pp. 17-40. + [8] P. Deuflhard, G. Bader, and U. Nowak. (1981). pp. 38-55. + In K.H. Ebert, P. Deuflhard, and W. Jager (eds.). Modelling of Chemical + Reaction Systems. Springer Series in Chemical Physics, Vol. 18. + Springer-Verlag, Berlin, 1981. + [9] E. Hairer, and G. Wanner. Solving Ordinary Differential Equations II. + Springer Series In Computational Mathematics, Vol. 14. Springer-Verlag, + Berlin, 1991. + [10] D. Kincaid, and W. Cheney. Numerical Analysis. Brooks/Cole, 1991. + + Last updated: 15 February 1995 by KG +****************************************************************************/ + +#include +#include +#include +#include "odesolv.h" + +/*************************************************************************** + The matrix manipulating routines like linear equation solvers are all + implemented in a small library. It is imported below. +****************************************************************************/ + +#include "matrix.h" + +/**************************************************************************** + Solver_ = 1: For stiff autonomous systems, [2, 5]. + + Semi-implicit third order Rosenbrock method. The constants a1_, b1_, R1_, + and R2_ are due to Calahan (e.g. [2] and [5]). + Adaptive stepsize control: Step-doubling. + The routine CalahanOneStep take one step of the integration algorithm, and + the routine Calahan take care of the step-doubling. + The output from Calahan: xnew_ and xerr_ contain respectively the new values + and the estimate of the local error of the dependent variables. +*****************************************************************************/ + +void CalahanOneStep(int N_, double htime_, double *x_, double *xnew_, + void (*f_)(double *, double *), void (*jac_)(double *)) { + + static const double a1_ = 0.788675134594813; /* (3.0+sqrt(3.0))/6.0 */ + static const double b1_ = -1.15470053837925; /* -2.0/sqrt(3.0) */ + static const double R1_ = 0.75; + static const double R2_ = 0.25; + + double **A_; + double *k1_, *k2_, *temp_; + double dummy_; + int *index; + int i, j; + + A_=MatrixAlloc(N_); + index=IntVectorAlloc(N_); + temp_=VectorAlloc(N_); + k1_=VectorAlloc(N_); + k2_=VectorAlloc(N_); + + dummy_=1.0/htime_; + f_(x_, k1_); + jac_(x_); + for(i=0; i +#include +#include "model.h" +#include "randgen.h" + +double u[n_grids][equa]; +double dx, dt, L, max_t; +double R[equa]; +char prefix[25]; +double ptime1, ptime2, period; + + +/*************************************************************************** + The following routines are taken from [1], but modified by the + author. +***************************************************************************/ + +/* (C) Copr. 1986-92 Numerical Recipes Software +,. */ + +void tridag(double a[], double b[], double c[], double r[], + double u[], int n) { + + int j; + double bet, gam[n_grids]; + + if (b[0] == 0.0) fprintf(stderr, "Error 1 in tridag"); + u[0]=r[0]/(bet=b[0]); + for (j=2;j<=n_grids;j++) { + gam[j-1]=c[j-2]/bet; + bet=b[j-1]-a[j-1]*gam[j-1]; + if (bet == 0.0) fprintf(stderr, "Error 2 in tridag"); + u[j-1]=(r[j-1]-a[j-1]*u[j-2])/bet; + } + for (j=(n_grids-1);j>=1;j--) + u[j-1] -= gam[j]*u[j]; +} + +void cyclic(double a[], double b[], double c[], + double alpha, double beta, double r[], double x[], + int n) { + + int i; + double fact, gamma, bb[n_grids], u[n_grids], z[n_grids]; + + if (n <= 2) fprintf(stderr, "n too small in cyclic\n"); + gamma = -b[0]; + bb[0]=b[0]-gamma; + bb[n_grids-1]=b[n_grids-1]-alpha*beta/gamma; + for (i=2;i big) big=temp; + if (big == 0.0) fprintf(stderr, "Singular matrix in routine ludcmp\n"); + vv[i-1]=1.0/big; + } + for (j=1;j<=n;j++) { + for (i=1;i= big) { + big=dum; + imax=i; + } + } + if (j != imax) { + for (k=1;k<=n;k++) { + dum=a[imax-1][k-1]; + a[imax-1][k-1]=a[j-1][k-1]; + a[j-1][k-1]=dum; + } + *d = -(*d); + vv[imax-1]=vv[j-1]; + } + indx[j-1]=imax; + if (a[j-1][j-1] == 0.0) a[j-1][j-1]=TINY; + if (j != n) { + dum=1.0/(a[j-1][j-1]); + for (i=j+1;i<=n;i++) a[i-1][j-1] *= dum; + } + } +} + +void lubksb(double a[equa][equa], int n, int indx[equa], double b[equa]) { + + int i,ii=0,ip,j; + double sum; + + for (i=1;i<=n;i++) { + ip=indx[i-1]; + sum=b[ip-1]; + b[ip-1]=b[i-1]; + if (ii) + for (j=ii;j<=i-1;j++) sum -= a[i-1][j-1]*b[j-1]; + else if (sum) ii=i; + b[i-1]=sum; + } + for (i=n;i>=1;i--) { + sum=b[i-1]; + for (j=i+1;j<=n;j++) sum -= a[i-1][j-1]*b[j-1]; + b[i-1]=sum/a[i-1][i-1]; + } +} + +/**************************************************************************** + The next two routines are a Gauss-Seidel lin. eqs solver. +*****************************************************************************/ + +double Dist(double x[n_grids], double y[n_grids]) { + +/* Distance defined by infinity norm */ + + int i; + double temp=0.0; + + for(i=0; i=EPS) && (iter<=MAX_ITER)); +} /* GaussSeidel */ + + +void initialize(char paramfile[25]) { + + int i, l; + FILE *infile; + char filename[25]; + double noise_level, init_val[equa]; + + init_diff_const(); + infile=fopen(paramfile, "r"); + fscanf(infile, "dt......= %lg\n", &dt); + fscanf(infile, "L.......= %lg\n", &L); + fscanf(infile, "prefix..= %s\n", prefix); + fscanf(infile, "max_t...= %lg\n", &max_t); + fscanf(infile, "pt1.....= %lg\n", &ptime1); + fscanf(infile, "pt2.....= %lg\n", &ptime2); + fscanf(infile, "period..= %lg\n", &period); + for(l=0; l=ptime1) && (t<=ptime2)) { + sprintf(filename, "%s.co%d", prefix, l, iter); + outfile=fopen(filename, "a"); + for(i=0; i +#include + +double arctan_local(Complex z) { + #define PI 3.14159265359 + double angle; + + if (z.re != 0.0) { + angle= ComplexArg(z); + /* + if (z.re<0.0) + angle += PI; + */ + if (angle >PI) + angle -= (2.0*PI); + } else { + if (z.im>0.0) { + angle= PI/2.0; + } else { + angle= PI/(-2.0); + } + } + return (360.0/2.0/PI*angle); +} /* arctan_local */ + +void compamppha(int n, double **P, double *amp, double *phase) { + + int i; + Complex z; + double hlp; + + for(i=0;i +#include + +extern double arctan_local(Complex); +extern void compamppha(int, double **, double *, double *); +extern void stopdata(int, int, double **, double *, + double *, double *, double *, double *); + +#endif diff --git a/Solvers/randinit.c b/Solvers/randinit.c new file mode 100644 index 0000000..66e5798 --- /dev/null +++ b/Solvers/randinit.c @@ -0,0 +1,8 @@ +/************************************************************************* + This program generates a random configuration for per1d.c. + + (C) Copyright 1996 by Kenneth Geisshirt. + + Last modified: 26 March 1996 +***************************************************************************/ + diff --git a/Solvers/sparse.c b/Solvers/sparse.c new file mode 100644 index 0000000..7365d82 --- /dev/null +++ b/Solvers/sparse.c @@ -0,0 +1,100 @@ +/************************************************************************* + (C) Kenneth Geisshirt (kneth@fatou.ruc.dk) + Department of Life Sciences and Chemistry + Roskilde University + P.O. Box 260 + 4000 Roskilde + Denmark + + This is a simple implementation of sparse matrices. + + References: + [1] Direct Methods for Sparse Matrices. O. Osterby and Z. Zlatev. + Lecture Notes in Computer Science, 157, 1983. Springer-Verlag. + [2] Computational Methods for General Sparse Matrices. Z. Zlatev, + Kluwer Academic, 1991. + [3] Sparse Matrix Techniques. Eds. A. Dold and B. Eckmann. Lecture + Notes in Mathematics, 572, 1979. Springer-Verlag. + + Last updated: 19 April 1995 +**************************************************************************/ + +#include +#include + +#include "sparse.h" + + +/************************************************************************* + SPorder reorders the data stored in the matrix, [1, pp. 20-21 +**************************************************************************/ + +void SPorder(SPmatrix A) { + + int i, j; + + for(i=0; iN; i++) { + A->ha[i][0]=0; + A->ha[i][2]=0; + A->ha[i][3]=0; + A->ha[i][5]=0; + } /* for i */ + for(i=0; iNZ; i++) { + j=A->cnr[i]; + A->ha[j][6]++; + j=A->rnr[i]; + A->ha[j][3]++; + } /* for i */ + n1=A->N-1; + for(i=0; iha[i+1][0]=A->ha[i][1]+A->ha[i][2]; + A->ha[i+1][3]=A->ha[i][3]+A->ha[i][5]; + A->ha[i][2]=A->ha[i][0]; + A->ha[i][5]=A->ha[i][3]; + } /* for i */ + A->ha[A->N-1][2]=A->ha[A->N-1][0]; + A->ha[A->N-1][5]=A->ha[A-N-1][3]; + i=A->rnr[A->NZ-1]; + j=A->cnr[A->NZ-1]; + xp=A->data[A->NZ-1]; + A->rnr[A->NZ-1]=-1; + A->k=A->N; + for(i3=1; i3NZ; i3++) { + i1=A->ha[i][2]+1; + A->ha[i][2]=i1; + i=A->rnr[i1]; + A->rnr[i1]=-1; + z=A->data[i1]; + A->data[i1]=xp; + xp=z; + j1=A->cnr[i1]; + A->cnr[i1]=j; + j=j1; + if (i<=0) { + do { + i2=A->ha[k][0]; + A->k--; + i=A->rnr[i2]; + } while (i<0); + A->rnr[i2]=-1; + xp=A->data[i2]; + j=A->cnr[i2]; + } /* if */ + } /* for i3 */ + i1=A->ha[i][2]+1; + A->ha[i][2]=i1; + A->data[i1]=xp; + A->cnr[i1]=j; + for(i=1; iN; i++) { + j1=A->ha[i][0]+1; + j2=A->ha[i][2]; + for(j3=j1; j3cnr[j3]; + k=A->ha[j][5]+1; + A->rnr[k]=i; + A->ha[j][5]=k; + } /* for j3 */ + } /* for i */ +} /* SPorder */ + + diff --git a/Solvers/sparse.h b/Solvers/sparse.h new file mode 100644 index 0000000..86b02cf --- /dev/null +++ b/Solvers/sparse.h @@ -0,0 +1,24 @@ +/************************************************************************* + (C) Kenneth Geisshirt (kneth@fatou.ruc.dk) + Department of Life Sciences and Chemistry + Roskilde University + P.O. Box 260 + 4000 Roskilde + Denmark + + This is header file of a small library for sparse matrices. + + Last updated: 18 April 1995 +**************************************************************************/ + +#ifndef _SPARSE_MATRIX_LIB_ +#define _SPARSE_MATRIX_LIB_ + +struct sparse_matrix { + double *A; /* the elements */ + int *CNR; + int *RNR; + int nz; /* number of elements */ + int N; /* number of rows/columns */ + + diff --git a/TODO.md b/TODO.md new file mode 100644 index 0000000..4e4a983 --- /dev/null +++ b/TODO.md @@ -0,0 +1,13 @@ +# TODO + +There is still some work to do with `kc`. Beside fixing bugs, the +following list shows with which priority different subject should be +done: + +* Better reduction of expressions. +* Better memory allocation (especially in `symbmath.{c,h}`). +* Better documentation, both user's and programmer's manual. +* Reorganise the table manager. +* Rewrite the grammar, i.e. better error recovery and many more consistency checks. + + diff --git a/docs/inst-dos.tex b/docs/inst-dos.tex new file mode 100644 index 0000000..8e7312f --- /dev/null +++ b/docs/inst-dos.tex @@ -0,0 +1,72 @@ +% Last updated: 6 July 1994 +\documentstyle[12pt]{article} +\author{Kenneth Geisshirt\thanks{Email:{\tt kneth@osc.kiku.dk}}} +\title{Installation of \\ Kinetic Compiler and Integrator \\ for + MS-DOS.} +\date{6 July 1994} +\begin{document} +\maketitle +In this brief note, I will describe how to install the MS-DOS version +of {\tt kc}. The compiler system comes with an integrator of ordinary +differential equations, and therefore it is required to have installed +a C-compiler. I recommend djgpp which is a DOS version of gcc. In the +following discussion, I will assume that djgpp is installed in a +directory called {\tt c:$\backslash$djgpp}. + +Begin with making two new diectories, one for the kinetic compiler +(let us call it {\tt c:$\backslash$kci}) and one for temporary files +({\tt c:$\backslash$temp}). + +It is vital to expand the memory space used by enviroment variables, +and is done by inserting the line + +\begin{verbatim} +shell=c:\command.com /p /e:1024 +\end{verbatim} + +\noindent +into the file {\tt config.sys}. The enviroment space is now 1024 +bytes. In the file {\tt autoexec.bat} you have to insert the line + +\begin{verbatim} +call c:\djgpp\bin\setdjgpp c:/djgpp c:\djgpp +\end{verbatim} + +The batch file called {\tt setdjgpp.bat} is setting up the C-compiler. +It might be a good idea to edit the lines which set the variables +GO32DIR and TMPDIR so they reflects the directory for temporary files. +Remember to expand the path, so both {\tt c:$\backslash$kci} and {\tt + c:$\backslash$djgpp$\backslash$bin} are included. + +Now copy all the files on the {\tt kc} disk into the directory called +{\tt c:$\backslash$kci}. There are a number of files; they are: + +\begin{description} +\item[kci.bat] This is the main ``program''. It runs the kinetic + compiler, the C-compiler and the simulation program. You should edit + the directories so they reflect your own setup. If the model is in + file {\tt foo.des}, then a simulation is done by typing {\tt kci + foo.des}. The batch file also does some cleaning up after the + simulation, so only the output file is left. +\item[kc] It is just the kinetic compiler. +\item[kksolver.c] Here we have the integration routines. +\end{description} + +The installation of the C-compiler should be fairly simple. The files +are compressed with arj, and you begin by going to the directory where +you want to compiler ({\tt c:$\backslash$djgpp}). Now you type + +\begin{verbatim} +arj x a:djgpp +\end{verbatim} + +It will ask you a few questions, but just give Y as answer. The next +disks are installed with the command: + +\begin{verbatim} +arj x a:djgpp.a01 +\end{verbatim} + +The number (a01) is increased for each disk. +\end{document} + diff --git a/docs/kc-intro.tex b/docs/kc-intro.tex new file mode 100644 index 0000000..f1e7b22 --- /dev/null +++ b/docs/kc-intro.tex @@ -0,0 +1,343 @@ +\hyphenation{che-mi-cal dif-fe-ren-tia-ting} +\documentstyle{article} +\author{Kenneth Geisshirt \\ \small (e-mail: kneth@\{vscht.cs, kiku.dk\}) \normalsize} +\title{Yet Another Kinetic Compiler} +\date{20 August 1992} +\begin{document} +\bibliographystyle{plain} +\maketitle +\begin{abstract} + Yet another kinetic (pre-)compiler called {\tt kc} has been implemented. The development serves + two goals; easy to use and easy to extend. The current version (0.~00) generates + code to CONT, \cite{marek} and to an integrator developed at University of Copenhagen. +\end{abstract} +\section{Introduction} +A kinetic (pre-)compiler's task can be defined very simple. It transforms a chemical +kinetic model into a runnable program. In this case the runnable program is only +a subroutine to existing programs like CONT and not a complete program. + +The two goals of the program development have been: +\begin{itemize} + \item Easy to use, i.~e.~the input is much like the 'paper model'. + \item Easy to extend, i.~e.~new features can easily be created. +\end{itemize} + +The second goal is achieved by structuring the code and by intensive use of +concrete data types, which hides the details of implementation. Heavy documentation +is also considered as a important factor in achieved the goal, because future +programmers can find how different parts are interacting. + +The status of the program can be summerised to: +\begin{itemize} + \item The precompiler is at the moment running on a HP 9000s720 under HP-UX 8.~05. + \item Semantic checks are not fully implemented, which means that a some 'logic' + errors are not detected. + \item Code generation by the use of mass-action law and power law is working. + \item Parameters and initial concentrations may be specified. +\end{itemize} + +In the following sections, all optional parts in grammars are placed between brackets ([ and ]). + +\section{Precompilers} +There exist already quite a lot chemical precompilers 'on the market'. They are often a ad hoc solution +of a problem and not general-purpose compilers. A few of these can be mentioned. +\begin{description} + \item[Kin.] Kin is developed at University of Copenhagen. The system generates HP-Pascal code and the + integrator finds the concentrations as a function of time, i.~e.~a dynamical simulation. The + program is able to take care of linear constraints and calls of external functions (like Arrhenuis). + The syntax is very easy, because it looks like ordinary chemical equations. But even through it is easy + to use, the code generator is hard to extend. + \item[Ionic.] This is a preprocessor developed at Prague Institute of Chemical Technology. The syntax has + to very much like Fortran-77, and the program is also generating subroutines in Fortran. The program + is meant to be used in one application area; diffusion controlled reactions. + \item[CONEX.] CONEX, \cite{conex}, is a specialised front-end to CONT. It is an expert system, which assists the user in + making the right decision about input to CONT. It is also capable of generating the subroutine used + by CONT. It is not flexible in the sense, that is is a front-end to one particular program. +\end{description} + +The three programs above all lack of flexibility. They are hard to extend to be used to generate input to +other programs. + +The approach in {\tt kc} is a bit different. A flexible front-end (lexical analyser, parser and symbol tables) +is developed, and back-ends (code generators) can be created when needed without changing the front-end. +This approach has the advantage that the user will have a consistent user-interface. The future back-end +programmer is not to write new front-end. This will properly save a lot of time in the process of +development. + +\section{Main features} +The following features are present in this version of {\tt kc}. +\begin{itemize} + \item Relative easy and general syntax. + \item Code generating to CONT and Kin by the use of mass-action law and power law. + \item Symbolic differentiating of expressions. + \item Portability (written in ANSI-C, {\em yacc} and {\em lex}, \cite{ctools}, \cite{KR}). +\end{itemize} + +The symbolic library is capable of doing ordinary algebraic manipulations like +addition and multiplication. To make the library more usable, a simplification routine +is implemented, because it is well-known that differentiating by computer often leads +to rather large expressions. + +The differentiating could have been done by using automatic differentiating techniques, \cite{autodiff}. This will +in many cases had let to more efficient subroutines, especially for very large models. + +\section{Running {\tt kc}} +To run {\tt kc} is in fact simple. The following is to be typed on the command +line. +\begin{verbatim} +kc [options] < file +\end{verbatim} +where {\tt file} is the name of the file, which contains the model. The precompiler +will respond by writing the line: +\begin{verbatim} +kc v0.00, CopyWrong by Kenneth Geisshirt, 1992. +\end{verbatim} +If there are no other messages, the compilation has been without errors and the output is written +to a file, which name depends on which code generator there is used. + +The options are in general a minus (-) and a letter. In this version three options are valid. They are +{\em m}, {\em d} and {\em h}. Option {\em h} writes a short help text on the screen. The {\em d} +options enable the debugging mode, i.~e.~the parser will write some debug information on +the screen (to understand the output, the user have to know the theory of LALR-grammars +and their parsers). The last option ({\em m}) determines the mode. In this moment, there +are two modes available. It is the mode 1, which is using symbolic differentiating +code generator to CONT, +and mode 4, which generates code to Kin. +The mode is written as a number after the {\em m} without +any white-spaces. + +Syntax errors are only reported as {\tt syntax error}, and no indication in which line. Only a +few other errors are detected, like defining a equilibrium constant when the reaction is a one-way +reaction. +When one syntax error has been encountered, the compiler will not continue. In finding the line +with the syntax error, the debug mode can be of great help. + +\section{Syntax of input} +The input syntax is very important to every program. The input to {\tt kc} can be divided +into three parts. These three parts are {\em parameters}, {\em equations} and {\em +constants}. +In three subsections I will examine each part, but first let's consider some +general principles. + +\subsection{Numbers} +Numbers are of course of great importance for {\tt kc}. But there exists only one +form of numbers, namely floating-point numbers. The general number in other word the form +\begin{verbatim} + xxx[.yyy[Ezzz]] +\end{verbatim} +In short, the numbers of {\tt kc} are like floating-point numbers in normal programming +languages. The main difference is, that the exponent has to have a sign ({\tt +} or {\tt -}). + +\subsection{Names} +Names used in {\tt kc} follow also the common conventions of programming languages. But +there is one difference. Only letters and digits are allowed, i.\ e.\ underscore (\_), +etc.\ can not be used. And capital letters are not the same as non-capital letters, e.~g.~ +{\tt Water} is not the same as {\tt water}. + +\subsection{Species} +Species are written the same way all through the source file. A specie consists +in this context of a name and a charge. The charge is written in parentheses. The +syntax for a specie is: +\begin{verbatim} + name [( charge )] +\end{verbatim} +Since radicals have to be represented this way also, the charge can either +be a number or a dot (.~). The last indicates a radical. + +The charge can of course either be positive or negative. If no charge is +given, it is assumed that the specie is neutral. Charges can be given +as floating-point numbers if it is needed. + +\subsection{Parameters and inclusions} +This part of the input is optional, i.~e.~it does not have to be there. +The part contains definitions of parameters. A parameter can be used 'later' in the +source file. An example could be the temperature. Each definition has the form +\begin{verbatim} + name = expr +\end{verbatim} +where {\tt expr} is an expression, which can be evaluated at that point in the source +file. + +An other feature in this part is inclusion of other files. This feature is not yet +supported. + +\subsection{Equations} +The equations determined the concrete system, which is been modelled. There are two +kinds of equations; chemical and mathematical equations. The mathematical equations +have not yet been implemented, but the chemical ones are. + +Every equation begins with a number. The number has to be a integer and unique for be +equation. After the number there has to be a colon (:). + +The chemical equation has the form: +\begin{verbatim} + number : [number] specie + ... arrow + [number] specie + ... ; constants ; +\end{verbatim} + +The optional number before a specie is the stoichiometric coefficient. The arrow +shows which kind of reaction it is. There are three kinds of reactions. They are: +one-way, two-way and equilibrium. The notation for these are {\tt ->}, {\tt <->} +and {\tt =}. The constant-section of the equation gives the rate constants and +the possible constants for the power law. + +Rate constants and equilibrium constants are denoted by the following symbols: +{\tt k>}, {\tt k<} and {\tt K}. The first two is for reactions, resp.~left to right +and right to left. The last one is a equilibrium constant. Constants used in the power +law is denoted by {\tt c} followed by the specie in parentheses. + +The assignment for all these constants have the form: +\begin{verbatim} + const = expr +\end{verbatim} + +\subsection{Constraints, constants and initial conditions} +This part of the source file is meant to define various constants and constraints. The constants +in this part is specie-specific, i.~e.~they are associated with a specie (could be molar mass). + +Only one feature is at the moment implemented; it is initial concentrations. A initial concentration +has the form: +\begin{verbatim} +[specie](0) = expr +\end{verbatim} + +Not that the brackets don't mean a optional part. They show that it is a concentration. The +specie has the form already discussed. + +\section{Limits} +The program can not handle infinite large models. But the size of the +model can be rather large. The table below shows various limits of the +current version. + +\vspace{.2cm} +\begin{tabular}{|l|r|} +\hline + Description & Limit \\ \hline \hline + Reactions/equations & 250 \\ \hline + Species + paramters & 200 \\ \hline + Constraints & 50 \\ +\hline +\end{tabular} +\vspace{.2cm} + +These values can easily be changed; they are found as macros in the +file {\tt tableman.h}. + +\section{Examples} +In this section I will give some examples of input to the program. +All the examples have the last line in common ($10 = 10$). The line has +no meaning, but every source file must contain some definitions of constants +at the end of the file. But this part has not yet been fully implemented (only +initial concentrations). + +In all examples, the rate constants are set 'randomly' i.~e.~they +have no chemical interpretation. + +The first examples is a first order reaction. A compound ($A$) is transformed +into a product ($P$). The rate constant is set to $1.0$ for simplicity. The source +file is: +\begin{verbatim} +1: A -> P; k> = 1.0; +10=10; +\end{verbatim} + +The next examples is more complicated. +\begin{verbatim} +1: A -> X; k> = 1.0; +2: B + X -> Y + D; k> = 2.0; +3: 2 X + Y -> 3 X; k> = 3.0; +4: X -> E; k> = 4.0; +10=10; +\end{verbatim} + +Ions are, as already mentioned, also supported in this version. An examples +of this, let's have the following red-ox reaction: +\begin{verbatim} +1: 2 Fe(+3) -> 3 Fe(+2); k> = 10.0; +10=10; +\end{verbatim} + +Initial concentrations and parameters are allowed. The next example shows this. +\begin{verbatim} +T = 1000 +1: A + B -> P; c(A)=1.2; c(B)=2.1; c(P)=5.0; k>=5*T; +[A](0)=0.1; +[B](0)=0.2; +\end{verbatim} + +\section{Code generators} +There are at the moment two code generators implemented. The first one generates +the subroutine to CONT, while the second one generates to Kin. + +In the subroutine used by both integrators have to have two quantities evaluated. They are the vector +$F$ and the matrix $G$. In this case $F$ is the rate of the reactions, while $G$ is +the Jacobian matrix defined as $\frac{\partial F_i}{\partial x_j}$, where $\underline{x}$ is the +concentration vector. + +The vector $F$ is generated by the mass-action law and the power-law. The code generator +is fooled, becaused the parser inserts the constants in power-expression as coefficients. +This gives a more compact code generator. For the reaction (number $i$) +\[ a A + b B + \cdots \rightarrow x X + y Y + \cdots \] +$F_i$ becomes: +\[ F_i = k [A]^a [B]^b \cdots \] +where $k$ is the rate constant. If the reaction is a two-ways reaction, $F_i$ becomes +\[ F_i = k_1 [A]^a [B]^b \cdots - k_2 [X]^x [Y]^y \cdots \] + +The matrix $G$ is now 'easy' to evaluate, if all elements of $F$ is stored. +This is the case in these two code generators, and a pseudo-code for them is: +\begin{verbatim} +for all reactions, i + case one-way: + F(i) = rate constant for reaction i + for all species, j, in reaction i + F(i) = F(i) * [j]**S(i, j) + case two-ways: + F(i) = rate constant (left to right) for reaction i + for all species, j, on left side of reaction i + F(i) = F(i) * [j]**S(i, j) + temp = rate constant (right to left) for reaction i + for all species, j, on right side of reaction i + temp = temp * [j]**(-S(i, j)) + F(i) = F(i) - temp +for all reactions, i + for all species in system, j + G(i, j) = dF(i)/d[j] +\end{verbatim} + +The notation {\tt S(i, j)} is the coefficient (or constant for power-law) in reaction $i$, specie $j$, {\tt [j]} is +the concentration of $j$ and {\tt **} is the exponent operator (like Fortran-77). + +This is the code, which implements both code generators on a non-concrete level. The code is of course using +various library functions, which retrieve information from the data types. + + +\section{Future development} +In this section I will briefly discuss the future developments +of the program could be. In the near future a few points must be considered +as natural extension of the program. +\begin{description} + \item[Error handling.] In the current version there are only + a few error messages. Proper error handling is important + in the sense of user-friendliness. + \item[Constants.] The use of specie-specific constants will, in some applications, + be very important. The constants have to general, and not only diffusion constants. +\end{description} + +As a medium-term project general expression must have +high priority. I am thinking on general expression defining +the model, and not only by using chemical equations. There is at least two problems, which +have to be solved, +in this project. Firstly, there have to some kind of data type to handle the +expressions. Secondly, a proper code generator has to be written - maybe existing +generators can be extended in some way. + +The feature of including other files must be explored more intensively. +Questions like 'What are the files' contents?' must be answered. + +Other code generators must be added, but these extensions will +come naturally when they are needed. As mentioned in the introduction, none of the +code generators are using automatic differentiating. it could be interesting to implement +a generator using it, and then compare it with the existing ones. + +\bibliography{chaos} +\end{document} diff --git a/docs/kc-man.pdf b/docs/kc-man.pdf new file mode 100644 index 0000000..554108b Binary files /dev/null and b/docs/kc-man.pdf differ diff --git a/docs/kc-man.tex b/docs/kc-man.tex new file mode 100644 index 0000000..650add1 --- /dev/null +++ b/docs/kc-man.tex @@ -0,0 +1,36 @@ +\documentstyle[titlepage,12pt]{article} +\parindent=0cm +\newcommand{\ie}{{\em i.e.}} +\newcommand{\eg}{{\em e.g.}} +\newcommand{\etc}{{\em etc.}} +\newcommand{\diff}[2]{\frac{{\mathrm d}#1}{{\mathrm d}#2}} +\begin{document} +\begin{titlepage} +\begin{center} +{\Large +User's Manual to Kinetic Compiler version 1.00 } \\ + +\vspace{5cm} +Kenneth Geisshirt \\ +{\footnotesize {\tt kneth@osc.kiku.dk}} \\ +Department of Theoretical Chemistry \\ +H.C.\ {\O}rsted Institute \\ +Universitetsparken 5 \\ +2100 Copenhagen \\ +Denmark \\ + +\vspace{3cm} +{\footnotesize 5 October 1994} +\end{center} +\end{titlepage} + +\tableofcontents +\newpage +\input{kc-man2} +\end{document} + + + + + + diff --git a/docs/kc-man2.tex b/docs/kc-man2.tex new file mode 100644 index 0000000..1d7aabf --- /dev/null +++ b/docs/kc-man2.tex @@ -0,0 +1,557 @@ +% Last updated: 6 Apr 1995 +\section{Introduction} +The kinetic compiler is a program which converts a chemical model into an +equivalent simulation program. + +This manual describes the kinetic compiler {\tt kc} version 1.00. The manual +will describe the program from the user's point of view, \ie the input +format and not the internal workings. + +The internals of the compiler are documented elsewhere, Geisshirt +\cite{kc:prog}. This document can be obtained from the author. + +The kinetic compiler forms a language much like an ordinary programming +language. The only difference is the size. While real programming languages +are big, the kinetic compiler's is small. + +In this manual I will use {\tt type writing} in examples and terminals +in grammars. The brackets ([ and ]) will surround optional parts, +while curled brackets (\{ and \}) will be 0, 1 or more repetitions of a +part in the grammars. A vertical line ($|$) denotes a choice between +two grammar parts. Normal parenthesis group grammar parts. + +\newpage +\section{Basics} +In this section I will examine the basic components of {\tt kc}, \ie +numbers, names and expressions. + +\subsection{Numbers} +In the language of {\tt kc} there is only one type of numbers. It is essential +floating-point numbers. They have the form: \\ +\{ {\tt digit}\} [{\tt .} {\tt digit}\{{\tt digit}\} [({\tt E}$|${\tt +e}) {\tt +} $|${\tt -} {\tt digit} {\tt digit}] + +The following numbers are legal: +\begin{verbatim} +322 +5.0 +0.1 +5.0e+10 +\end{verbatim} + +Negative numbers are supported as a part of the expressions instead of +a part of the number. Please note, that the sign of the exponents have +to be written, \eg like the last number above. + +\subsection{Species} +Species are essential to the kinetic compiler. A species consists of a name +and a charge. The ``grammar'' of a species is: \\ +{\tt name} [{\tt (} ({\tt +}$|${\tt -}) [{\tt number}]{\tt )}] + +A name is a letter followed by letters and digits. The following species are +legal: +\begin{verbatim} +H2O +H(+) +SO4(-2) +\end{verbatim} + +The parenthesis is the charge of the species. A dot (.) denotes +radicals, and if the charge is omitted, it is assumed to be zero. + +Capital letters and non-capital letters are {\em not} the same, \ie the +compiler is case-sensitive. The sign of the charge must be written +down, \ie both minus and plus signs! + +\subsection{Concentrations} +Concentrations can be specified in {\tt kc}. They are written using the +convention in chemistry, \ie a species in brackets ([ and ]). The +concentration of {\tt H2O} can be written as {\tt [H2O]}. + +\subsection{Expressions} +Expressions are meant to implement general calculations in the +compiler. The expressions are the same as found in ordinary +programming languages. + +An expression ({\tt expr}) is defined recursively by:\\ +{\tt expr} op {\tt expr} + +The op is an operator. It can be one of the five operators used in +mathematics, \ie addition, subtraction, multiplication, division, +and power-raising. + +They are written as: + +\begin{center} +\begin{tabular}{llc} +\hline +Operator & In {\tt kc} & Precedence \\ \hline +Addition & {\tt +} & 3 \\ +Subtraction & {\tt -} & 3 \\ +Multiplication & {\tt *} & 2 \\ +Division & {\tt /} & 2 \\ +Power & {\tt **} or {\tt $\hat{}$} & 1 \\ +\hline +\end{tabular} +\end{center} + +Expressions can be surrounded by parenthesis, \ie {\tt ( expr )}. An +expression can also just be a numeric constant (a number) or a +symbolic constant (a name). One can in some cases also use concentrations +in an expression, see section \ref{model}. Finally, an expression can +change sign by {\tt - expr}. + +Functions can also be used in expressions. All the usual functions are +implemented. An application of a function has the form: + +\begin{verbatim} +f ( expr ) +\end{verbatim} +where {\tt expr} is an expression and {\tt f} is the function. The +following functions are implemented: + +\begin{center} +\begin{tabular}{ll} +\hline +Function & Description \\ \hline +{\tt sin} & sine \\ +{\tt cos} & cosine \\ +{\tt tan} & tangent \\ +{\tt asin} & the inverse of sine, \ie $\sin^{-1}$ \\ +{\tt acos} & the inverse of cosine, \ie $\cos^{-1}$ \\ +{\tt atan} & the inverse of tangent, \ie $\tan^{-1}$ \\ +{\tt sinh} & hyperbolic sine \\ +{\tt cosh} & hyperbolic cosine \\ +{\tt tanh} & hyperbolic tangent \\ +{\tt asinh} & the inverse of hyperbolic sine \\ +{\tt acosh} & the inverse of hyperbolic cosine \\ +{\tt atanh} & the inverse of hyperbolic tangent \\ +{\tt exp} & the exponetial function ($e^x$) \\ +{\tt ln} & base $e$ logarithm \\ +{\tt log} & base 10 logarithm \\ +\hline +\end{tabular} +\end{center} + +Let me close this section with an example: + +\begin{verbatim} +A*exp(-dE/(k*T))-1.5*C^2 +\end{verbatim} + +\subsection{Running {\tt kc}} +Running the compiler is easy. It is done by typing the following on the +command-line: \\ +{\tt kc} [options] {\tt < input-file} + +The compiler creates the output files. All options are a hyphen (minus sign) +followed by a letter. There are the following options: + +\begin{center} +\begin{tabular}{ll} +\hline +Option & Description \\ \hline +q & quiet mode \\ +h & Help \\ +m & Mode \\ \hline +\end{tabular} +\end{center} + +The last option (m) is followed by a number. The mode is a code generator, +which generates code to a specific program. To see which modes {\tt kc} +supports, run the program with option h ({\tt kc -h}). In +the present version the following code generators are supported + +\begin{center} +\begin{tabular}{cll} +\hline +Mode & Code generator & Description \\ \hline +2 & KGadi & A solver for reaction-diffusion systems \\ +3 & kci & A dynamical simulator written in ANSI-C \\ +5 & KnCont & Continuation program \\ +6 & Finn & Calculating various properties \\ \hline +\end{tabular} +\end{center} + +\newpage +\section{The input} +In this section I will explain the overall structure of the input to +the {\tt kc}. The input to {\tt kc} consists of three parts; +definitions, the model and constraints. +Each part is in the following subsections. The three parts are written +in the same order in the input file. + +\subsection{Definitions} +In this part of the input file, one can define constants, which can be used +later in the input file. A (symbolic) constant is a name, which has been +assigned a value. The constants are written as: + +\begin{verbatim} +const = expr; +\end{verbatim} + +The compiler must be able to evaluate the expression at that moment, +\ie the expression is not allowed to contain any undefined constants. +The constant can also be a string. In that case the expression on the +left hand side is a sequence of letters and digits surrounded by +quotation marks. Note that it is not possible to used full stops (.), +dashed (-) or anything like that in strings. + +In this part the user can also specify which symbolic names, which are +going to be used in a continuation. The parameter declaration is + +\begin{verbatim} +#paramter {param expr, expr, expr, expr, expr}; +\end{verbatim} + +These five values are used in the continuation, but I will not +describe them here, since the supporting mode is not yet fully functional. + +\subsection{The model} +\label{model} +The model is a set of chemical reactions and/or a set of ordinary +differential equations. The reactions are written in the +``usual'' way, \ie a coefficient and a species plus another coefficient and +a species and so on. Two different reactions can be used; uni-directional and +bi-directorial. They are written using {\tt ->} and {\tt <->}. The +bi-directorial reaction can also use {\tt <=>}. + +The rate constants are written after the reaction. A reaction always +begin by a number. A legal reaction is: + +\begin{verbatim} +1: H(+) + HO(-) <-> H2O; k>=1.0; k<=2.0; +\end{verbatim} + +The default code generating uses the law of mass action. This default can +be overriden. One can either use power law or general expressions. The +first is simple. After the reaction, one can write the power constants. Their +grammar is {\tt c(species) = expr}. When using the power law, the user must +still write the rate constants. + +The general expression kinetic is also very simple to write down. Instead of +rate constants, the user can write a general expression. They are +thought to be used in enzyme kinetics, but may also be useful in other +areas. A legal input of this kind is + +\begin{verbatim} +1: A + B <-> C; v>=2*[A]; k<=10 +\end{verbatim} + +Note that it is possible to use a mix of the three kinetics (mass action, power +and general) in the same model. + +Often the parameter in a continuation is a rate constant. In this +case, the rate constant is just set equal to the name of the +parameter, \ie the name declared in at the {\tt \#}{\tt parameter} directive. + +Ordinary differential equations are normally written as + +\[ + \frac{dx}{dt} = f(x), +\] +and the compiler's grammar is + +\begin{verbatim} +name' = expr; +\end{verbatim} +where {\tt name} is the $x$ and {\tt expr} is the velocity field specified +by $f$. + +\subsection{Constraints} +\label{SpecConst} +In the last part of the input, all the constraints and initial conditions are +placed. It is also possible to specify constants for the species. + +The constraints have the form {\tt [species] = expr}. The constraints reduces +the number of dynamical variables in the model. Chemical equilibrium +is also modelled this way. A legal constraint is {\tt [A] = 12-[B]}. + +Initial conditions specify which values the concentrations of the species have +at $t=0$. This is done by {\tt [species](0) = expr}. If no initial +concentration is given, the compiler assumes, that the concentration is +zero. For dynamical variables defined by ordinary differential +equations, the initial value can also be specified. This is done by +{\tt name(0) = expr}. + +To each species one can assign a number of constants. Some code generators +may use \eg the diffusion coefficient of the species. The constants +will have a name followed by the species in parenthesis, \eg +{\tt D(A) = 1e-5}. + +\newpage +\section{The code generators} +For each code generator, there are various constants and parameters, +which can be given a value. In this section I will discuss the various code +generators. + +\subsection{kci} +Kci is able to solve ordinary differential equations numerically. +There is a number of parameters, which can be get. + +\begin{center} +\begin{tabular}{llr} +\hline +Parameter & Description & Default value \\ \hline +dtime & interval between printouts & 2.0 \\ +etime & time for endning simulation & 200.0 \\ +htime & initial step size & 1.0 \\ +stime & initial time & 0.0 \\ +epsr & relative tolerence & $10^{-5}$ \\ +epsa & absolute tolerence & $10^{-10}$ \\ +epsmin & minimal precision & machine precision\footnote{The + computer's precision is determined at run-time.} \\ +method & integration method (see below) & 1 \\ +stepadjust & & 0.9 \\ +maxinc & & 1.5 \\ +mindec & & 0.5 \\ +scaling & & 0 \\ +htimemin & minimal step size & $10^{-20}$ \\ +datafile & name of output file & kinwrkdat \\ +printafter & time to start printing & 0\\ +mode & mode (see below) & 0 \\ +prnmode & printing mode (see below) & 0 \\ +debug & debug level (see below) & 0 \\ +\hline +\end{tabular} +\end{center} + +The ``method'' determines which integration scheme to use, and it can have +the following values: + +\begin{center} +\begin{tabular}{rl} +\hline +Value & Method \\ \hline +1 & Calahan \\ +2 & Rosenbrock (RKFNC) \\ +3 & 4th order Runge-Kutta \\ +4 & Generalised Runge-Kutta \\ +5 & Rosenbrock for nonautonomous systems \\ +7 & Generalised Runge-Kutta for nonautonomous systems \\ +\hline +\end{tabular} +\end{center} + +The ``mode'' parameter decides different ways of using the simulator. +The ``mode'' 0 is default. The table below gives the possibilities: + +\begin{center} + \begin{tabular}{rl} + Mode & Description \\ \hline + 0 & Ordinary simulation \\ + 1 & Make perturbations \\ + \hline + \end{tabular} +\end{center} + +The perturbation is a simple feature: At a specified time, a vector is +added to the concentration vector (one can have negative values - +simulates dilution). The time for the first perturbation is given by +the parameter ``ptime'', while new perturbations are done by an +interval ``dptime''. If ``dptime'' is zero (default) only one +perturbation is done. + +In general the output file is readable by GNUplot. At the begining of +the file, the names of the dynamical variables are found. Some modes +may write additional information in the file and at the end. The +parameters ``prnmode'' and ``debug'' determine the additional +information printed. + +\begin{center} + \begin{tabular}{rl} + prnmode & Description \\ \hline + 0 & equidistant and extrama points \\ + 1 & equidistant points only \\ + \hline + \end{tabular} +\end{center} + + +\begin{center} + \begin{tabular}{rl} + debug & Description \\ \hline + 0 & none \\ + 1 & time, steplength, and dynamical variables \\ + 2 & as 1 + control parameters \\ + 3 & initial values of control parameters \\ + \hline + \end{tabular} +\end{center} + + +In order to make the work easier for the user, there exists a small +script. The script runs the kinetic compiler, a C compiler \etc The +script is called kci\footnote{Kinetic Compiler and Integrator.}. If +the model is stored in a file called {\tt foo.des}, a simulation is +performed by {\tt kci foo.des}. It should be noted that the MS-DOS +version of the kinetic compiler uses a similar batch file (the name is +the same). + +\subsection{Kin} +\label{KCMAN:CodeKin} +Kin is a simulation package for chemical reaction, or to be more +precise, it is a solver of ordinary differential equations. +Calahan's method is used to solve stiff problems. This mode is +obsolent. + +The following parameters can be set as constants in the input to {\tt + kc}: + +\begin{center} +\begin{tabular}{llr} +\hline +Parameter & Description & Default value \\ \hline +tb & & 1 \\ +dt & step between prints & 1 \\ +etime & end time & 10 \\ +hb & & 1 \\ +epsr & relative precision & $1 \cdot 10^{-3}$ \\ +epsa & absolute precision & $1 \cdot 10^{-20}$ \\ +mode & run mode & none \\ +ptime & perturbation time & none \\ \hline +\end{tabular} +\end{center} + +The ``mode'' parameter have the following meaning: + +\begin{center} +\begin{tabular}{ll} +\hline +Value & Description \\ \hline +0 & Ordinary simulation \\ +1 & Make a perturbation at {\tt ptime} \\ \hline +\end{tabular} +\end{center} + +If initial concentrations are specified, they will be used. The +concentrations used in the perturbation are declared as species +related constants, see section \ref{SpecConst}. The name of the +constant is {\tt pert}, and an example is: + +\begin{verbatim} +pert(X) = 0.1; +\end{verbatim} + +The output will always be stored on the file {\tt kinwrk.dat}, which is +readable by GNUplot\footnote{GNUplot is a plotting program, which can + be obtained by anonymous ftp.}. + +The easiest way to use this mode, is to use the script {\tt kkin}. +Let us assume that the input file is called {\tt model.des}. The +run is then done by the command: {\tt kkin model.des}. + +\subsection{KGadi} +This code generator supplies code to a simulator of reaction-diffusion +systems. Therefore diffusion coefficients must be specified. They are +specified by the species-related constant {\tt D}. Diffusion +coefficients for variables specified by differential equations cannot +be defined in the input to {\tt kc}. The user must edit the routine +{\tt init\_diff\_const} in the file {\tt model.c} by hand. There are the +following constants to be used: + +\begin{center} +\begin{tabular}{llr} +\hline +Parameter & Description & Default value \\ \hline +mgrid & grid points, horizontal & none \\ +ngrid & grid points, vertical & none \\ +length & length of system & 100 \\ +dt & time step & 2 \\ +update & time between saving on disk & 10 \\ +print1 & time before saving & 100\\ +print2 & time for ending saving & 100 \\ +mode & run mode & 0 \\ \hline +\end{tabular} +\end{center} + +The ``mode'' parameter determines which kind of simulation to perform. +If the parameter is not defined, it will be a ordinary simulation, +where the concentrations are saved every ``update'' second. +The table below shows the possibilities. + +\begin{center} +\begin{tabular}{rl} +\hline +Value & Description \\ \hline +0 & Ordinary simulation. \\ +1 & Generates a sequence of ``images'' between ``print1'' and +``print2''. \\ +\hline +\end{tabular} +\end{center} + +The easist way to use this mode, is to use the script called +{\tt rdsim}. If the model is in file {\tt file.mod}, a simulation is +performed by the command {\tt rdsim file.mod}. + +\newpage +\section{Known bugs} +No program is bug free, and {\tt kc} is no exception. I have knowledge +of the following bugs: + +\begin{enumerate} +\end{enumerate} + +\newpage. +\section{An example} +The following is an example of input to {\tt kc}. + +{\footnotesize +\begin{verbatim} +/* Test model is from "Bifurcation diagram ..." by Ipsen et al. */ + +Ceo = 0.000833333; +j0 = 2.77L-3; +stime = 0; +dtime = 10; +etime = 6000; +psr = 1.0L-4; +espa = 1.0L-20; + +101: HBrO2 -> P; k> = j0; +101: Br(-) -> P; k> = j0; +103: CeIV -> P; k> = j0; +104: HOBr -> P; k> = j0; +105: BrO2 -> P; k> = j0; +106: Br2 -> P; k> = j0; +107: BrMA -> P; k> = j0; +109: MAR -> P; k> = j0; +110: MAin -> MA; k> = j0; + +1: BrO(-3) + Br(-) + 2H(+) <=> HBrO2 + HOBr; k>=0.01352/0.1/0.26/0.26; k<=3.2; +2: HBrO2 + Br(-) + H(+) -> 2HOBr; k>=5.2L+5/0.26; +3: BrO(-3) + HBrO2 + H(+) <=> 2BrO2 + H2O; k>=0.858/0.1/0.26; k<=4.2L+7/55.5; +4: BrO2 + CeIII + H(+) <=> HBrO2 + CeIV; k>=1.612L+4/0.26; k<=7.0L+3; +5: 2HBrO2 -> HOBr + BrO(-3) + H(+); k>=3.0L+3; +6: Br(-) + HOBr + H(+) <=> Br2 + H2O; k>=6.0L+8/0.26; k<=2/55.5; +7: MA + Br2 -> BrMA + Br(-) + H(+); k>=40.0; +8: MA + HOBr -> BrMA + H2O; k>=8.2; +9: MA + CeIV -> MAR + CeIII + H(+); k>=0.3; +10: BrMA + CeIV -> CeIII + Br(-) + P; k>=30.0; +11: HOBr -> P; k>=0.080; +12: HOBr -> Br(-); k>=0.140; +13: MAR + HOBr -> Br(-) + P; k>=1.0E+7; +14: 2MAR -> MA + P; k>=3.0E+9; +15: MAR + BrMA -> MA + Br(-) + P; k>=2.4E+4; +16: MAR + Br2 -> BrMA + Br(-); k>=1.5L+8; + +[H(+)] = 0.26; +[P] = 0; +[H2O] = 55.5; +[BrO(-3)] = 0.1; +[MAin] = 0.25; +[CeIII] = Ceo-[CeIV]; + +[HBrO2](0) = 2.85055L-7; +[Br(-)](0) = 1.42745L-6; +[CeIV](0) = 2.84792L-6; +[HOBr](0) = 6.13549L-6; +[BrO2](0) = 3.09064L-8; +[Br2](0) = 4.20280L-8; +[MA](0) = 2.47010L-1; +[BrMA](0) = 1.20977L-3; +[MAR](0) = 3.98455L-9; +\end{verbatim} +} + diff --git a/docs/kc-paper.tex b/docs/kc-paper.tex new file mode 100644 index 0000000..295c4e3 --- /dev/null +++ b/docs/kc-paper.tex @@ -0,0 +1,393 @@ +% Last updated: 18 Apr 1995 +\documentstyle[12pt]{article} + +\newcommand{\ie}{{\em i.e.\ }} +\newcommand{\eg}{{\em e.g.\ }} +\newcommand{\etc}{{\em etc.\ }} +\newcommand{\etal}{{\em et al.\ }} +\newcommand{\smbox}[1]{\mbox{{\footnotesize #1}}} +\newcommand{\diff}[2]{\frac{{\rm d}#1}{{\rm d}#2}} +\newcommand{\R}{{\rm R}} +\newcommand{\chem}[1]{\mbox{$\rm #1$}} +\author{Preben Graae S{\o}rensen, Finn Hynne and Keld Nielsen \\ Department of + Theoretical Chemistry \\ H.C. {\O}rsted Institute \\ + Universitetsparken 5 \\ 2100 Copenhagen \\ Denmark \\ + Kenneth Geisshirt \\ Department of Life Sciences and Chemistry \\ + Roskilde University \\ P.O.\ Box 260 \\ 4000 Roskilde \\ Denmark} +\title{Yet Another Chemical Compiler} +\date{18 April 1995} + +\begin{document} + +%\bibliographystyle{unsrt} +\maketitle + +\begin{abstract} + This paper describes a new chemical compiler we have developed. The + package consists of a program, which is able to convert a set of chemical + reactions into a simulation program, and solvers of differential + equations. +\end{abstract} + +\section{Introduction} +Many authors have reported development of chemical compilers, see \eg +Stabler \etal \cite{Stabler78}, Carver \etal \cite{79}, Deuflhard +\etal \cite{Deuflhard}, Ipsen \etal \cite{Ipsen91}, Edelson +\cite{Edelson76}, Rasmussen \etal \cite{ChemSimul84}, Bieniasz +\cite{Bieniasz92}. But they are all +more or less primitive compared to the one we are going to present +here. Often they have been used in a specialised subject, \eg +atmospheric chemistry, while our system is a general-purpose one. + +\section{Motivation} +In general, problems in chemical kinetics are described by $n$ +coupled differential equations + +\begin{equation} +\label{KinODE} + \diff{\vec{c}}{t} = \vec{f}(\vec{c}), +\end{equation} +with the initial concentrations $\vec{c}(0) = \vec{c}_0$. + +If we have $n$ species and $m$ reactions, we have $n$ differential +equations, each with up to $m$ terms. It is not difficult to write +down the equations from the reactions, but the probability of making +an error is nearly 1. We human beings have one major disadvantage - +boring work is error prone, and to write down rate expressions must be +regarded as boring. + +When we automatise the process, the focus is move from writting down +rate expressions to the actual simulations. In order words, we will +gain in productivity in our work. + +Large kinetic models are difficult to work with. As already mentioned, +the work of transforming a kinetic model into a simulation program is +huge. In order to reduce the number of variables, many researchers apply +the quasi steady state approximation (QSSA). But the problem is that +the QSSA may not be valid; and this is not know in advance. A chemical +compiler does the use of the QSSA obsolent. + +\section{The compiler} +Our chemical compiler is based on a certain input language to describe +chemical reactions. The language is formally given as an +LALR(1)\footnote{LookAhead 1 symbol, read Left to Right.} +grammar, see \eg Aho \etal \cite{Dragon}, Levine \etal \cite{YaccLex} +for a more detailed description. The advantages of using such an +abstract definition of the input format is that there exist tools +which can generate the parser automaticly. The parser is the part of a +compiler which read the input file and checks the syntax. + +Furthermore the compiler is written in ANSI-C, which means that it is +easy to port to various Unix-based computer systems, and we have even +ported it to MS-DOS\footnote{It can only run on i386-based computers +or higher using a DOS-extender, \eg DJGPP or EMX.}. + +An input file consists of a number of sections: constants, +reactions/equations, constraints, and initial concentrations. +Expressions found in ordinary programming languages like Fortran-77 +and C are used, \ie we we below say an expression, think of it as an +expression from a program. + +Constants are declared in the beginning of a file. The declaration is +simply: + +\begin{verbatim} + name = 10; +\end{verbatim} +where {\tt name} is the name of the constant, and after the equal sign +comes a (general) expression. + +The reactions are written in a natural way - natural for a chemist at +least. An example is the reaction $\chem{H^+} + \chem{HO^-} +\rightarrow \chem{H_2O}$ is written as + +\begin{verbatim} + 1: H(+) + HO(-) -> H2O; k>=1.0e+14; +\end{verbatim} +where {\tt k>=} represents the rate constant, and the number in the +beginning of the line is the number of the reaction. If a reaction is +written in this way, it is assumed, that it follows a rate law which +is consistent with the law of mass +action. But the user is able to supplied her own rate expression. The +Michaelis-Menten mechanism consists of three reactions, Laidler +\cite{Laidler:ChemKin} + +\begin{equation} + E + S \raisebox{-12pt}{\shortstack{$k_a$ \\ $\rightleftharpoons$ \\ +$k'_a$}} (ES) \stackrel{k_b}{\rightarrow} P+E, +\end{equation} + +The rate law is + +\begin{equation} + \diff{[P]}{t} = \frac{k_b[S]}{K_M+[S]}[E]_0, +\end{equation} +where $K_M = \frac{k_b+k'_a}{k_a}$. The input to our compiler could be + +\begin{verbatim} + KM = (kb+ka2)/ka1; + 1: S -> P; v>=(kb*[S])/(KM+[S])*E0; +\end{verbatim} +if we assumed that the constants are declared in the input file. + +In many chemical models, there are constraints on the concentration of +some species. We have chosen that all supported constraints must have +the form + +\begin{equation} +{\rm [Spec]} ={\rm expr;} +\end{equation} +where {\tt [Spec]} denotes the concentration of {\tt Spec}, which is +contrained, and {\tt expr} is an expression, which may contain the +concentrations of other species. The constraints implemented in this +fashion is not the same as a QSSA species. While in the QSSA the +concentration becomes constant after a while, our constraints are +strictly valid at all times. + +The last section of the file consists of initial concentrations. An +example is + +\begin{verbatim} +[H(+)] = 1.0e-7; +\end{verbatim} + +A larger example of an input file is shown below. The overall reaction +is decomposition of ozone with iron, \cite{Frank}. + +\begin{verbatim} +etime = 10.0; +dtime = 0.05; +prnmode = 1; + + +2: Fe(+2) + O3 -> FeO(+2) + O2; k>=8.2e5; +3: FeO(+2) + Fe(+2) -> 2Fe(+3) + H2O; k>=1.4e5; +4: 2FeO(+2) -> 2Fe(+3) + OH(-) + HO2(-); k>=50; +5: FeO(+2) + H2O2 -> Fe(+3) + HO2 + OH(-); k>=1.0e4; +6: FeO(+2) + HO2 -> Fe(+3) + O2 +OH(-); k>=2.0e6; +11: FeO(+2) -> Fe(+3) + OH + OH(-); k>=1.3e-2; +13: FeO(+2) + OH -> Fe(+3) + HO2(-); k>=1.0e7; + +[O3](0) = 1.3e-4; +[Fe(+2)](0) = 1.1e-4; +[H2O2](0) = 1.0e-5; +\end{verbatim} + +\section{Symbolic versus numerical differentiation} +Our chemical compiler is able to do symbolic differentiation of +expression when generating the subroutines needed to do the +simulations. It is a simple matter to do this kind of operation, if +the rate expressions follows the law of mass action. The chemical +compiler described here, is able to do differentiation of any +expression. + +We are able to demonstrate that the symbolic differentiation is +better than the numerical one. Not only do we not make any +approximation errors, we also save computer time! + +In the following discussion, the time of the basic operations are +denoted by $T_{\smbox{oper}}$. By basic operations, we mean addition, +subtraction, multiplication, division, and power-raising. If $f$ and +$g$ are two general expression, the time of evalutating $f \mbox{ oper } +g$ is given by + +\begin{eqnarray} + T(f\pm g) &= T(f) + T(g) + T_{\smbox{add}} \\ + T(f\cdot g) &= T(f) + T(g) + T_{\smbox{mul}} \\ + T\left(\frac{f}{g}\right) &= T(f) + T(g) + T_{\smbox{div}} \\ + T(f^g) &= T(f) + T(g) + T_{\smbox{pow}}, +\end{eqnarray} +where we have assumed that time of addition is the same as for a +subtraction. The time to fetch a variable from the storage of the +computer is $T_{\smbox{var}}$, while loading a constant takes +$T_{\smbox{const}}$. + +Kinetics that follows the law of mass action, can be expressed as + +\begin{equation} + f_i = \sum_{r=1}^n \nu_{ir}k_r \prod_{s=1}^m c_s^{\nu_{sr}}, +\end{equation} +and the time it takes to evaluate this is + +\begin{eqnarray} + T(f_i) &=& (2n+nm)T_{\smbox{const}} + nmT_{\smbox{var}} + +(2n+nm)T_{\smbox{mul}} \nonumber \\ +& & + nmT_{\smbox{pow}} + nT_{\smbox{add}}. +\end{eqnarray} + +A numerical differentiation scheme is, Kincaid \etal \cite{NumAna:KC} + +\begin{equation} + \frac{\partial f_i}{c_j} \approx \frac{f_i(c_j+h) - f_i(c_j-h)}{2h} +\equiv \frac{\delta f_i}{\delta c_j}, +\end{equation} +while the element of the Jacobian matrix exactly is + +\begin{equation} + \frac{\partial f_i}{\partial c_j} = \sum_{r=1}^n \left(\nu_{ir} k_r + \left(\prod_{s=1,s\not=j}^m c_s^{\nu_{sj}}\right) + \nu_{ij}c_j^{\nu_{ij}-1}\right). +\end{equation} + +The time consumption for these two differentiation schemes are + +\begin{eqnarray} + T\left(\frac{\delta f_i}{\delta c_j}\right) &=& (4n + 2nm + + 4)T_{\smbox{const}} + + (2nm + 2)T_{\smbox{var}} \nonumber \\ + & & + (4n+2nm+1)T_{\smbox{mul}} + T_{\smbox{div}} + + (2n+3)T_{\smbox{add}} + 2nmT_{\smbox{pow}}, \\ + T\left(\frac{\partial f_i}{\partial c_j}\right) &=& + (nm+3n)T_{\smbox{const}} + nmT_{\smbox{var}} \nonumber \\ + & & + nmT_{\smbox{pow}} + (mn+3n)T_{\smbox{mul}} + nT_{\smbox{add}}. +\end{eqnarray} + +As we see, the symbolic scheme is in general faster than the numerical +one. Of course it is take longer time to generate the expressions when +the chemical compiler is running, but this we will gain during the +simulation. + +\section{Numerical procedures} +\label{sec:NumProc} +The compiler has been developed in order to help to do various +numerical tasks, \ie simulations and continuations. The primary work +area for our compiler is dynamical simulations of macroscopic chemical +kinetics, and therefore we have spent such effort in developing +numerical solvers for ordinary differential equations. + +\subsection{Ordinary differential equations} +\label{sec:ODEs} +The general model of chemical kinetics is + +\[ + \diff{\vec{c}}{t} = \vec{f}(\vec{c}), +\] +where $\vec{c}$ is an $n$-dimensional vector and $\vec{f}$ is a +general function mapping $\R^n$ onto $\R^n$. The solution is unique if +we specify the initial conditions. + +In the literature of numerical analysis one can find many numerical +schemes for solving ordinary differential equations, and we have +selected only a few. + + +\subsection{Fourth order Runge-Kutta} +\label{sec:RK4} +The most simple solver is a fourth order Runge-Kutta. The method is +described \eg by Press \etal \cite[pp.\ 710--714]{NumAna:NumRec}. + +If the solution at step $n$ is $\vec{c}_n$, then the solution at $n+1$ +is computed as + +\begin{eqnarray*} + \vec{k}_1 &=& h\vec{f}(\vec{c}_n), \\ + \vec{k}_2 &=& h\vec{f}(\vec{c}_n + \frac{\vec{k}_1}{2}), \\ + \vec{k}_3 &=& h\vec{f}(\vec{c}_n + \frac{\vec{k}_2}{3}), \\ + \vec{k}_4 &=& h\vec{f}(\vec{c}_n + \vec{k}_3), \\ + \vec{c}_{n+1} &=& \vec{c}_n + \frac{\vec{k}_1}{6} + + \frac{\vec{k}_2}{3} + \frac{\vec{k}_3}{3} + \frac{\vec{k}_4}{6}, +\end{eqnarray*} +where $h$ is the step length. + +The method is a said previously of order 4, and it cannot solve stiff +equations. + + +\subsection{Calahan} +Calahan \cite{Calahan} has described a scheme for solving stiff +equations. The method can be characterised as a semi-implicit third +order Rosenbrock method. + +One step is given as + +\begin{eqnarray*} + \vec{k}_{n+1} &=& h \left( {\matrix{E} - h a_1 + \matrix{J}(\vec{c}_n)} \right)^{-1} \vec{f}(\vec{c}_n), \\ + \vec{l}_{n+1} &=& h \left( {\matrix{E} - h a_1 + \matrix{J}(\vec{c}_n)} \right)^{-1} \vec{f}(\vec{c}_n + b_1 + \vec{k}_{n+1}), \\ + \vec{c}_{n+1} &=& \vec{c}_n + R_1\vec{k}_{n+1} + R_2\vec{l}_{n+1}, +\end{eqnarray*} +where $h$ is the step length, $\matrix{J}$ is the Jacobian matrix of +$\vec{f}$, and $\matrix{E}$ is a unit matrix. + +The constants are: $a_1 = \frac{3+\sqrt{3}}{6}$, $b_1 = +-\frac{2}{\sqrt{3}}$, $R_1 = \frac{3}{4}$, and $R_2 = \frac{1}{4}$. + +\subsection{Fifth order Runge-Kutta} +\label{sec:RKFNK} + +RKFNK + +\subsection{Generalised Runge-Kutta} +\label{sec:GRK4T} +The Runge-Kutta scheme can be extended in order to be able to handle +stiff equations. Kaps \etal \cite{Kaps79} have deduced such a method. +The method used is modified as outlined by Press \etal \cite[pp.\ +738--742]{NumRec}, Kaps \etal \cite{Kaps85}, and Hairer \etal +\cite{Hairer91}. + + + +\subsection{Step control} +\label{sec:StepControl} + + + + +\section{Examples} +We have tested our integrator for ordinary differential equations with +many different test examples. The figures are running time in seconds. + +\begin{table}[htbp] + \begin{center} + \leavevmode + \begin{tabular}{lrrr} + \hline + Test & Calahan & RKFNC & GRK4T \\ \hline + A1 & 3.01 & 1.56 & 0.83 \\ + A2 & 4.80 & 257.72 & 2.54 \\ + A3 & 1.73 & 67.22 & 0.53 \\ + A4 & 23.96 & 117.91 & 9.32 \\ + B1 & 27.61 & 4.37 & 6.06 \\ + B2 & 4.61 & 0.54 & 2.01 \\ + B3 & 6.18 & 0.69 & 1.89 \\ + B4 & 10.89 & 1.27 & 5.13 \\ + B5 & 35.54 & 6.30 & 11.59 \\ + C1 & 1.70 & 1.45 & 0.71 \\ + C2 & 1.38 & 1.20 & 0.70 \\ + C3 & 1.03 & 1.09 & 0.60 \\ + C4 & 1.63 & 1.06 & 0.71 \\ + C5 & 1.93 & 1.18 & 0.84 \\ + D1 & 4.70 & 6.16 & 2.57 \\ + D3 & 0.87 & 3.63 & 0.95 \\ + D4 & 1.61 & 71.67 & 0.75 \\ + D5 & 0.70 & 14.45 & 0.57 \\ + D6 & 0.88 & & \\ + Lorenz & 4.90 & 0.84 & 2.94 \\ + \hline + \end{tabular} + \end{center} + \caption{Time measurements of misc.\ numerical schemes. The + measurements were done on an i486-based PC (25 MHz) running Linux + v1.0. The times are in seconds, and they are the total time spent + on the integration (user + system time).} + \label{tab:TimeNumScheme} +\end{table} + +Since we are chemists, we have tested our new compiler with chemical +mechanics for different reactions. We will here give a few examples + + + +\section{Conclusion} +We have now shown the implementation of a new chemical compiler. It is +designed in such a way, so it can be extended in the future. + +The compiler and the integrators are put in the public domain, and the +packages can be obtained from the authors. + +%\bibliography{datalogi,chemkin,fyskemi,numana} +\end{document} + + diff --git a/docs/kc-pre.tex b/docs/kc-pre.tex new file mode 100644 index 0000000..41b75b6 --- /dev/null +++ b/docs/kc-pre.tex @@ -0,0 +1,164 @@ +\documentstyle{article} +\author{Kenneth Geisshirt} +\title{Preanalysis of kinetic precompiler} +\date{5 August 1992} +\begin{document} +\maketitle +\section{Paths to go} +There exist two paths, which can be used. The first is to extend the +{\tt kin} program and the other is to start from scratch, i.\ e.\ to +begin from nothing and write every line of code. This preanalysis' aim +is to uncover the two paths and give (unprecise) plans of proceeding. + +\section{Extending {\tt kin}} +Extending an existing program can only be done when the new program is +a superset of the previously. This is true in this case. But, and there +is a but, there are some major disadvantages which have to be considered. +Of course there are also advantages, some obvious and some not. + +Let me begin with the advantages. The first one is obvious; a lot of the +work has already been done. This means that a lot of time can be saved. +The saved time can then be used on the extension. But even this obvious +advantages can easily degenerate to nothing, if the program is written in +a way, which prohibits extension. A non-extentable program is written so +the structure is a spagetti-form, and there is no documentation of what +the data structures are doing. The {\tt kin} system has a good structure, +but lacks of documentation. There are comments in the source file, but +the data structures (and their operations) are not documented. + +The second advantage is the concept of superset. The new program can still +use old input without changes, like the upgrade from Fortran-77 to +Fortran-90 (or in some cases from C to C++). +In reaching this goal, the programmer has to be aware of the +goal. + +One of the disadvantages is already mentioned briefly. If the system has no +structure the programmer will use too much time in finding the places to +make the extensions. This is actually the case with {\tt kin} in one +respect. The feature of calling external functions was added after the +designing the system. It is therefore a ad hoc solution of a program, and +it is not the most structured solution. + +Even though the structure of the {\tt kin} system is well-formed, the +lack of concrete data types is a major problem. There are of course +variuos data structures, but they are defined, so they are fitting their +purpose. They are not defined as black-boxes, so the programmer is +able to take advantage the actual representation. This missing structure +can, in my opion, give problems when extending the program. Black-boxes in +modules are easier to alter and extend, because they don't interact with +each other and the main program. + +If one has to extend the {\tt kin} system, one has to find out the precise +meaning of every variable and statement (almost). This requires time, +maybe two days or more. Then the extension can be made. The problem is, that +changes in the input format may lead to changes in already existing code, +which complicates the matter. + +\section{Writing every line of code} +Writing the program from the bare nothing is like inventing the wheel twice +when somebody already had solved some of the problems. Some of the problems +{\em are} solved in the {\tt kin} system. By starting from scratch one +can be free of the failures and misunderstandings +of the past, i.\ e.\ old programs. + +Instead of analysing the problem once more (a lot of the analysis from +the previous section could easily the reused here), I will setup some +kind of a plan of work. The plan can of course only a guide of the +work. + +\subsection{Format of input} +The format of the input is of great importance. It is important, because +of two reasons. The first is, that this is what the user is going to live +live with as long as he or the program is alive. The second reason is, that +a mistake or error in the early step of development, can easily ruin the +project. It is very expensive (especially in time) to change decisions +made early in the project, because all the analysis, design and implementation +have to be done again. + +\subsection{Reading input} +If the format of the input is given as (LALR) grammar, a lexical analyser +and parser can be generated using the standard tools {\em lex} and {\em +yacc}. At the moment I am not used to use {\em lex}, but the +manual can be found on the CD-ROM. The actual work is to write down +the semantic actions, which are to be inserted into the source file +used by {\em yacc} - to write down the grammar is only a question of +minutes, when it is defined. +But the semantic actions are not of interest in this section! When +using these two tools +this part of +the project is almost trivial. +There exists substitutes called {\em Flex} and {\em Bison} +\footnote{{\em Bison} is already installed on Tiger.}, but they +do the same job as {\em lex} and {\em yacc}. Another substitute +is {\em BOBS}, which replaces both {\em lex} and {\em yacc} but uses +Pascal as programming language. + +By using these tools, one can save time +on the testing of the lexical analyser and the parser \footnote{One +has to assume, that one's tools are free of errors.}. + +\subsection{Data types} +I prefer to call them data types instead of data structures, because I will +see them as black-boxes, and the application programmer is not to know +their actual representation. To make to illusion of a black-box perfectly +I will defined operations, which restrict the interface to a mininal one. + +The data types used in this kind of application (compiler-like), is +often of the type insert-and-retrieve. The following data types seems +natural: +\begin{enumerate} + \item Species. + \item Reactions/mechamism, a kind of stoichiometric matrix. + \item Parameters. + \item Contrains. +\end{enumerate} + +The data type of species could have information on the name, the charge, +different properties of the actual specie (like enthalpy of formation). +The data type of reactions must then have information on which species +involved in which reaction, the rate constant, etc. + +Since the data types are insert-and-retrive types, the design and implementation +can be done in matters of days (at most a week). + +\subsection{Semantic actions} +This is the key problem in writing a (pre)compiler, even for a small langauge. +The semantic actions demand knowledge of both the source and target 'langauge'. +In this case, that means the programmer (me) has to be familiar with the process +of transforming the chemical model into a numerical model or input to +different programs. The semantic actions are to be called by the parser. When +using {\em yacc} the actions are inserted directly into the input file for +{\em yacc}. The semantic action can be used as a analysis of which data types +there are needed, especially which operations are needed. + +Since this is the key problem in the implementation, it will also be the part +which consumed most of the time. But when it is clear, how the actions are +going to be, it is merely just to type them into the program text. Finding +the proper actions and implement them, will take up about a week's work. + +\subsection{Testing} +To test a new program, and especially (pre)compilers, is very time consuming. +A proper, well-documented testing would take the same time as develop the +program, i.\ e.\ two weeks. Of course one can assumed that all tools are +working correctly, and therefore the lexical analyser is correct. The parser +will also be correct in the sense it is shifting and reducing in the right +order. But still, one has to test the semantic actions and by them also the +various data types, which have been defined. + +\subsection{Some already written} +Even through it sounds as a contradiction, I don't have to start from scratch, +because I have already written some of the code. Well, the grammar/input format have +to be extended, but the data types are implemented. Some of the code generator +is implemented. The missing parts are mainly semantic actions and some code +generating stuff. + +To work on in this direction is more promissing. I will write the all code, +but I don't have to start from point zero again. This code was written +more modular that the {\tt kin} system, so extending it with features like +power law and general mechanism cannot the the hardest work. + +There exists also some documentation of this project. This documentation's +aim is to describe the implementation, i.\ e.\ which data types are used +and so on. + +\end{document} diff --git a/docs/kc-ref.bib b/docs/kc-ref.bib new file mode 100644 index 0000000..cd71c3f --- /dev/null +++ b/docs/kc-ref.bib @@ -0,0 +1,61 @@ +@book{marek, + title="Chaotic Behaviour of Deterministic Dissipative Systems", + author="M. Marek and I. Schreiber", + year=1991, + publisher="Academia Press" +} + +@article{autodiff, + title="On Automatic Differentiating", + author="Andreas Griewank", + journal="Mathematical programming: {R}ecent Development and Applications", + year=1989, + note="Preprint" +} + +@inproceedings{conex, + title="Continuation expert system - {CONEX}", + year=1990, + author="P. Rosendorf and J. Orsag and I. Schreiber and M. Marek", + booktitle="The 2nd International coference on expert systems for numerical computing" +} + +@manual{ctools, + title="C programming tools", + organization="Hewlett-Packard" +} + + +@article{kc-intro, + title="Yet Another Kinetic Compiler", + author="Kenneth Geisshirt", + year=1992 +} + +@book{KR, + title="The C programming Language", + author="D. Ritchie and B. Kernighan", + publisher="Prentice-Hall", + year=1978 +} + +@book{dragon, + title="Compilers. Principles, Techniques and Tools", + author="Sethi and Aho and Ullman", + publisher="Wesley-Addison", + year=1986 +} + +@book{LexYacc, + title="lex \& yacc", + author="Levine and Mason and Brown", + publisher="O'Reilly \& Associates", + year=1993 +} + +@book{decker, + title="Data structures", + author="Rick Decker", + publisher="Prentice {H}all", + year = 1989 +} \ No newline at end of file diff --git a/docs/kc.1 b/docs/kc.1 new file mode 100644 index 0000000..34533f5 --- /dev/null +++ b/docs/kc.1 @@ -0,0 +1,33 @@ +.TH +kc 1m + +.SH +NAME +kc - kinetic compiler v0.25 + +.SH +SYNOPSIS +kc [options] < file + +.SH +DESCRIPTION +kc transform a chemical/kinetic model into one or more subroutines +used by an integrator. The integrator can be a continuation program +or a dynamical simulator. + +.SS +Options +There are four options. Help (h), mode (m), debug (d), and quiet (q). The +mode option determined which integrator, which is used. Run the +program with the help option to get the newest information. Mode 2 is +used together with a simulation program for reaction-diffusion systems, +written by Ole Jensen et al. +Mode 4 is a +dynamical simulator for chemical reaction and a solver of ordinary +differential equations. Mode 5 is a front-end to Keld Nielsen's continuation +program, and mode 6 calculates various properties of the given model: the +jacobian matrix, its eigenvectors and -values. + +.SH +AUTHOR +Kenneth Geisshirt, kneth@kiku.dk diff --git a/docs/kc.pdf b/docs/kc.pdf new file mode 100644 index 0000000..eb7f5a2 Binary files /dev/null and b/docs/kc.pdf differ diff --git a/docs/kc.tex b/docs/kc.tex new file mode 100644 index 0000000..2eedec9 --- /dev/null +++ b/docs/kc.tex @@ -0,0 +1,1403 @@ +\documentstyle[titlepage]{article} + +\parindent = 0cm +\parskip = 0.1cm + +\newcommand{\ie}{{\em i.e.\/}} +\newcommand{\eg}{{\em e.g.\/}} +\newcommand{\etc}{{\em etc.\/}} + +\input{psfig} + +\begin{document} + +\begin{titlepage} +\begin{center} +\vspace{7cm} +{\Huge Programmer's \\ Reference Manual \\ to \\ the Kinetic Compiler \\ + version 1.00} \\ +\vspace{2cm} +{\Large Kenneth Geisshirt \\ +{\normalsize kneth@osc.kiku.dk} \\ +Department of Theoretical Chemistry \\ +H.C. {\O}rsted Institute \\ +Universitetsparken 5 \\ +2100 K{\o}benhavn {\O} \\ +Denmark } \\ +\vspace{3cm} +{\Large 9 October 1994} +\end{center} +\end{titlepage} + +\bibliographystyle{plain} +\tableofcontents +\newpage + +\section{Introduction} +This manual is the technical documentation of {\tt kc}. The version +described is 1.00. The paper contains information on the data types +used in the program \ie the interface is given in all details. The group +of readers is thought as future programmers, who is going to extend +and maintain the program. + +The grammar wil also be explained. The parser and the +lexical analyser will briefly discussed as well. + +The reader is assumed to have knowledge of (ANSI) C, \cite{KR}, +LALR-grammars, \cite{ctools}, \cite{dragon}, \cite{LexYacc}, +concrete data types, \cite{decker} and Unix in general. +There exists also a user's manual to the system, \cite{kc-man}, and +the reader of this manual is recommended to this it before proceeding. + +The manual is structured in the following way: Each section documents a +concrete data type, the parser or just a module. Each +section begins with a small presentation and then the operations +follow, each in a distict subsection. All modules may be included +more than once, \ie just like the ordinary standard libraries. + +The source files discussed in the manual are in general found in the +{\tt src} directory of the {\tt kc} tree. + +\section{A brief overview} +The kinetic compiler is a compiler in the traditional understanding, +\ie it translate a given source language into a target language. The +source language is chemical reaction and ordinary differential +equations and the target language is subroutines for a simulation +program. + +The general structure of {\tt kc} is found below. The figure shows the +data stream. + +\begin{figure} + \fbox{\psfig{file=stream.ps,width=13cm,height=8cm}} + \caption{The data stream in the kinetic compiler.} +\end{figure} + +The lexical analyser and the parser read the input file, and they +insert the information contained in the file into various tables, here +called the symbol table. + +A natural data type of the system is general expressions. Especially +the code generators use expressions as well as the information stored +by the parser. The code generators is generating the output files. + +The figure below shows a simplified dependency graph of the main +libraries of the program. Each library is shown as a box. The library +called ``Code generators'' should be understood as a typical code +generator. + +\begin{figure} + \fbox{\psfig{file=lib-dep.ps,width=13cm,height=8cm}} + \caption{The dependency graph for the libraries.} +\end{figure} + +\section{Data type TableMan} +\label{tableman} +The data type TableMan is found the the file {\tt tableman.h}. The +purpose of the data type is to keep track +of the information, which is read from the input file. The table +manager is actual seven tables in one - +symbol table, reaction table, constraint table, dynamical variable +table, expression table\footnote{The tables of dynamical variables and + expression are closely related.}, print table, +and parameter table - but this does the programmer not be aware of. + +\subsection{The {\tt Direc} type} +\label{direc} +This type is used in some of the operations, either as input or +output. The type is an enumerated type, and has three values. + +\vspace{0.2cm} +\begin{center} +\begin{tabular}{ll} +\hline + Value & Description \\ \hline + uni & one-way reaction \\ + bi & two-ways reaction \\ + equi & equilibrium \\ +\hline +\end{tabular} +\end{center} +\vspace{.2cm} + +These three names and the type can be used, when the table manager is included. + +\subsection{SetupTableMan} +\begin{verbatim} +void SetupTableMan(void) +\end{verbatim} +This procedure is setting up the table manager. It is to be called +before any other routine in the table manager and only once. + +This routine will always return NoError. + +\subsection{GetError} +\begin{verbatim} +TableErrors GetError(void) +\end{verbatim} +The function returns an error code from last used operation in the +table manager. There are the following possible errors: + +\vspace{.2cm} +\begin{center} +\begin{tabular}{ll} +\hline +Error name & Description \\ \hline +NoError & no error \\ +TooManyConst & constant table full \\ +TooManySpec & species table full \\ +SpecAlready & species already defined \\ +KonstAlready & constant already defined \\ +NonSpec & \\ +TooManyReact & reaction table full \\ +WrongDirect & \\ +ReactAlready & reaction already defined \\ +NotFound & a search was unsuccesful \\ +TooManyConstrain & constraint table full \\ +TooManyDynVar & dynamical table full \\ +TooManyExpr & expression table full \\ +ExpreAlready & expression already defined \\ +TooManyPrn & print table full \\ +TooManyParam & parameter table full \\ +ParamAlready & parameter aldreay defined \\ +\hline +\end{tabular} +\end{center} +\vspace{.2cm} + +The definition of these names are found in the type {\tt TableErrors}, +which can be used when the table manager is included. + +\subsection{NewSpecie} +\begin{verbatim} +void NewSpecie(char *name, double charge) +\end{verbatim} + +The procedure defines a new species which has the name {\tt name} +and the charge {\tt charge}. Radicals have the +charge {\tt MAXFLOAT} which is defined in standard header file {\tt values.h}. + +The possible errors are NoError, TooManySpec and SpecAlready. The last +will occur, if the species already has been defined. This may mean +nothing and can be ignored. The second error is more problematic; I +do not have any solutions for that. + +\subsection{NewConstant} +\begin{verbatim} +void NewConstant(char *name, double value) +\end{verbatim} + +This procedure defines a new constant in the symbol table with name +{\tt name} and the value {\tt value}. If +the constant already is defined the returned error is KonstAlready. + +\subsection{NewDiffConst} +\begin{verbatim} +void NewDiffConst(char *name, double charge, double value) +\end{verbatim} + +The procedure assigns new value to a diffusion constant. If the species {\tt +name(charge)} has not been defined the error NonSpec is returned, +otherwise NoError. + +This procedure should not be used - it is an old procedure. One should +use NewSpecConst instead, see section \ref{tableman:NewSpecConst} + +\subsection{NewCoeff} +\label{newcoeff} +\begin{verbatim} +void NewCoeff(int react_no, char *name, double charge, + double coeff, int side) +\end{verbatim} + +This routine assigns a new coefficient for the species {\tt + name(charge)} in reaction number {\tt react\_no}. The routine is +supporting autocatalytic reactions. + +If {\tt side} is 1 the the coefficient is inserted on the left side, +otherwise on the right hand side. + +Please note, the procedure does {\em not} return any errors +(not NoError neither). + +\subsection{NewRateConst} +\begin{verbatim} +void NewRateConst(int react, int direc, Tree value) +\end{verbatim} + +The procedure sets a new value ({\tt value}) for the rate constant +in reaction {\tt react}. The parameter {\tt direc} gives the +following possibilities. + +\vspace{.2cm} +\begin{center} +\begin{tabular}{rl} +\hline + Value & Direction \\ \hline + -1 & $\rightarrow$ \\ + 0 & = \\ + 1 & $\leftarrow$ \\ +\hline +\end{tabular} +\end{center} +\vspace{.2cm} + +\subsection{NewBeginConc} +\begin{verbatim} +void NewBeginConc(char *name, double charge, double value) +\end{verbatim} + +The NewBeginConc procedure sets a new initial concentration for species {\tt +name(charge)}. The new value is the parameter {\tt value}. If the +species is not defined, the error code is NonSpec. + +\subsection{NewReaction} +\begin{verbatim} +void NewReaction(int react) +\end{verbatim} + +This procedure prepares a new reaction with the number {\tt react}. +There are three possible errors. +NoError will be the code, if the procedure was succesful. If there +was no space (reaction table full) the error code is TooManyReact, while if the +reaction already has been defined, the error code is ReactAlready. + +\subsection{AddReactionKind} +\begin{verbatim} +void AddReactionKind(int react, Direc direct) +\end{verbatim} + +This procedure adds the direction to a given reaction. Details on the +directions, see section \ref{direc}. The error code is not set in +this operation, \ie it can be +dangerous to used it, if one is not absolutely sure on the reaction +number (commonly determined by GetCurrentReact). + +\subsection{SpecieInReaction} +\begin{verbatim} +void SpecieInReaction(int react, char *name, double charge) +\end{verbatim} + +This operation inserts a new species ({\tt name(charge)}) into the +reaction table. The species is associated with reaction number +{\tt react}. The coefficient that the species has in the reaction +must be set by NewCoeff, see section \ref{newcoeff}. The reaction +number is during parsing determined by GetCurrentReact. + +There is no setting of error codes in this operation. + +\subsection{NewConstraint} +\begin{verbatim} +void NewConstaint(char *name, double charge, Tree expr) +\end{verbatim} + +This procedure prepares a new constraint. The error code is +TooManyConstrain if there is no space in the table. All constraints +are assumed to be in the form + +\begin{verbatim} +[J] = expr +\end{verbatim} +where {\tt J} is the species, \ie {\tt name(charge)}. + +\subsection{NumOfConstraint} +\begin{verbatim} +int NumOfConstraint(void) +\end{verbatim} + +This function returns the number of constraints defined so far. + +\subsection{GetConstraintNo} +\begin{verbatim} +void GetConstraintNo(int no, char *name, double *charge, Tree t) +\end{verbatim} + +This function finds the constraint number {\tt no} in the constraint +table. The error code is NotFound if the constraint does not exist. +The species associated with the constraint is returned in the +parameters {\tt name} and {\tt charge}. + +\subsection{GetReactNo} +\begin{verbatim} +int GetReactNo(int counter) +\end{verbatim} + +This function returns the reaction number (as defined when it was +created, \eg by the parser). The parameter {\tt counter} is the index +in the table of +reactions. This function is {\em not} pretty when used, but can be useful. + +\subsection{RenameSpec} +\begin{verbatim} +void RenameSpec(char *rename, char *name, double charge) +\end{verbatim} + +The operation renames the species {\tt name(charge)}, so both the name +and the charge become part of the new name {\tt rename}. The parameter +{\tt rename} has to be allocated before the call, +\eg by StringAlloc. + +The new name will have the form {\tt name\_charge}, where the +charge is converted so positive charge is $n$ times of {\tt p} and +negative charge is $n$ times of {\tt n} ($n$ is the integer part +of the charge). If the charge shows that it is a radical, the +suffix is {\tt rad}. + +No error codes are returned. + +\subsection{NoOfSpec} +\label{nospec} +\begin{verbatim} +int NoOfSpec(void) +\end{verbatim} + +This function returns the number of species, which have been defined so far. + +\subsection{GetFirstSpecA} +\label{GetA} +\begin{verbatim} +int GetFirstSpecA(int no, char *name, double *charge, + double *coeff, int side) +\end{verbatim} + +This function finds the first species in a in reaction {\tt no}. If no +species is found (or the reaction is not found) the function +returns 0, otherwise 1. The found species is returned in the +parameters {\tt name} and {\tt charge}. The coefficient +is returned in parameter {\tt coeff}. The {\tt side} parameter has be +0 if the species is to be found on the left side, otherwise 1. + +This function is meant to be used together with GetNextSpecA, +and GetFirstSpecA is the initial call. + +\subsection{GetNextSpecA} +\begin{verbatim} +int GetNextSpecA(char *name, double *charge, double *coeff, + int side) +\end{verbatim} + +This function continues the search started by {\tt GetFirstSpecA}, +see section \ref{GetA}. The returning values are also analogous to +that function. + +\subsection{GetCoeffInReact} +\begin{verbatim} +double GetCoeffInReact(int react_no, char *name, + double charge, int side) +\end{verbatim} + +The function returns the coefficient (if any) of the species +{\tt name(charge)} in reaction +number {\tt react{\_}no}. The {\tt side} parameter determine the side of +the reaction to search; 0 is left side, 1 is the right side. The +function does not return any error codes. + +\subsection{GetFirstSpecB} +\label{GetB} +\begin{verbatim} +int GetFirstSpecB(char *name, double *charge) +\end{verbatim} + +The function finds the first species in the symbol table, if there +is any. If the function +finds a species it returns 1, otherwise 0. The species is returned +in the two parameters. + +In a sense the routine (together with GetNextSpecB) is doing the same +as the NoOfSpec/GetSpecNo couple. + +\subsection{GetNextSpecB} +\begin{verbatim} +int GetNextSpecB(char *name, double *charge) +\end{verbatim} + +This function continues the search, which was begun by +{\tt GetFirstSpecB}, see section \ref{GetB}. +The return values also analogue to that function. + +\subsection{GetSpecNo} +\begin{verbatim} +void GetSpecNo(int count, char *name, double *charge) +\end{verbatim} + +The procedure finds species number {\tt count} in the symbol table. +The procedure returns the species in the two last parameters. +If no species is found the return values are undefined. +It is only safe to let {\tt count} be between 1 and the number +returned by {\tt NoOfSpec}, see section \ref{nospec}. + +\subsection{GetReactKind} +\begin{verbatim} +Direc GetReactKind(int react_no) +\end{verbatim} + +This function returns the reaction kind as defined by the type +{\tt Direc}, see section \ref{direc}. +The function has no error codes. The parameter {\tt react{\_}no} is the +reaction number defined when the reaction was inserted into the table, +and not the index of the table. + +\subsection{GetRateConst} +\begin{verbatim} +void GetRateConst(int react_no, Direc direct, int way, Tree value) +\end{verbatim} + +The function returns the rate constant of the reaction {\tt + react\_no}. +The function has to known which kind of reaction it is (parameter +{\tt direct}, see section \ref{direc}). +For two-ways reactions the parameter selects which of the two +constants there is returned, i.e. +{\tt way} has only meaning when {\tt direct} = {\tt bi}. +The table below shows the possibilities. + +\vspace{.2cm} +\begin{center} +\begin{tabular}{cc} +\hline + {\tt way} & Direction \\ \hline + 1 & $\rightarrow$ \\ + 2 & $\leftarrow$ \\ +\hline +\end{tabular} +\end{center} +\vspace{.2cm} + +\subsection{GetConstant} +\begin{verbatim} +double GetConstant(char *name) +\end{verbatim} + +The function returns the value of the constant {\tt name} in the +symbol table. If the constant has not been defined, the error code +is NotFound, and the return value is undefined. + +\subsection{GetBeginConc} +\begin{verbatim} +double GetBeginConc(char *name, double charge) +\end{verbatim} + +This operation finds and returns the initial concentration for the +given species. If the species has not been defined, the error code +is NotFound and the value of the initial concentration is undefined. + +\subsection{GetSpecNumber} +\begin{verbatim} +int GetSpecNumber(char *name, double charge) +\end{verbatim} + +This function finds the number the species {\tt name(charge)} +has in the table. No error code is returned. + +\subsection{NewDynVar} +\begin{verbatim} +void NewDynVar(char *name) +\end{verbatim} + +The operation inserts a new dynamical variable into the table. The +error code is TooManyDynVar if there is no space for it. + +\subsection{NumOfDynVar} +\begin{verbatim} +int NumOfDynVar(void) +\end{verbatim} + +The function returns the number of dynamical variables. + +\subsection{GetDynVarNo} +\begin{verbatim} +void GetDynVarNo(int i, char *name) +\end{verbatim} + +The routine finds dynamical variable number {\tt i} in the table and +copy it to the variable {\tt name}. +If {\tt i} is greater than the total number of variables the error +code is NotFound. + +\subsection{NewExpr} +\begin{verbatim} +void NewExpr(int no, Tree t) +\end{verbatim} + +This routine inserts a new expression into the expression table. The error +code is TooManyExpr if there is no room in the table. The error code is +ExprAlready if the expression is already defined, \ie the number {\tt no} +is already used. + +Expression in this context is a ordinary differentila equation. Each +expression is associated with a dynamical variable, \ie NewExpr is +almost always used in conjunction with NewDynVar. + +\subsection{NumOfExpr} +\begin{verbatim} +int NumOfExpr(void) +\end{verbatim} + +The function returns the number of expressions, which have been inserted +into the table. No error code is set. + +\subsection{GetExprNo} +\begin{verbatim} +void GetExprNo(int no, char *name, Tree t) +\end{verbatim} + +This function returns the expression and the associated dynamical +variable inserted as number {\tt no}. +If the expression is not found, \ie {\tt no} is greater than the +number of expression the error code is NotFound. + +\subsection{NewPowerConst} +\begin{verbatim} +void NewPowerConst(int react_no, char *name, double charge, double +value, int side) +\end{verbatim} + +The routine is analogous to NewCoeff, but the variable {\tt value} is a value +for the power-law kinetics. + +\subsection{GetPowConstInReact} +\begin{verbatim} +double GetPowConstInReact(int react_no, char *name, + double charge, int side) +\end{verbatim} + +The function is analogous to GetCoeffInReact, but returns the constant +used in a power-law kinetics. + +\subsection{IsSpecInConstraint} +\begin{verbatim} +int IsSpecInConstraint(char *name, double charge) +\end{verbatim} + +This function returns the constraint number, if there is any. If none +found, then the function returns 0, \ie the species in not +constrained. + +\subsection{NewRateExpr} +\begin{verbatim} +void NewRateExpr(int react, int direct, Tree value) +\end{verbatim} + +The routine defines a new expression for the rate of the reaction. +The expression is in the variable {\tt value}. The routine is +similar to NewRateKonst. + +\subsection{GetRateExpr} +\begin{verbatim} +void GetRateExpr(int react_no, Direc direct, int way, Tree t) +\end{verbatim} + +This function is similar to {\tt GetRateConst}, but instead it returns +an expression. + +\subsection{GetRateKind} +\begin{verbatim} +int GetRateKind(int react_no, Direc direct, int way) +\end{verbatim} + +The function returns the kind of reaction. There are two kinds of +reaction. When 2 is returned, the reaction rate is a general +expression, otherwise it is more standard +expressions\footnote{{\em E.g.\/} law of mass action.}. + +\subsection{NewSpecConst} +\label{tableman:NewSpecConst} +\begin{verbatim} +void NewSpecConst(char *name1, double charge, char *name2, + double value) +\end{verbatim} + +Each species can have up to 10 constants associated with it. This function +inserts a new one. The parameters {\tt name1} and {\tt charge} represent the +species, while {\tt name2} is the name of the constant and {\tt value} is +the numerical value of the constant. + +The constants thought of under the development was diffusion +coefficient and molar masses. + +\subsection{GetSpecConst} +\begin{verbatim} +double GetSpecConst(char *name1, double charge, char *name2) +\end{verbatim} + +This routine retrieves what NewSpecConst inserted into the symbol table. + +\subsection{IsVarParameter} +\begin{verbatim} +int IsVarParamter(char *name) +\end{verbatim} + +This function checks whether the variable {\tt name} is a dynamical +variable (defined by NewDynVar) or a parameter (defined by +NewParameter). If {\tt name} is a parameter, \ie inserted +into the expression table the return value is 1. + +\subsection{IsSpecParam} +\begin{verbatim} +int IsSpecParam(char *name, double charge) +\end{verbatim} + +This function returns 1 if the species defined by {\tt name} and {\tt + charge} is declared as a parameter to be used in a continuation. + +\subsection{NewLowHighPrefParam} +\begin{verbatim} +void NewLowHighPrefParam(char *name, double low, double high, + double pref) +\end{verbatim} + +This function inserts informations used for continuations. If the +parameter is not found, the error code is NotFound. + +\subsection{NewLowHighPrefConc} +\begin{verbatim} +void NewLowHighPrefConc(char *name, double charge, double low, + double high, double pref) +\end{verbatim} + +This function is similar to NewLowHighPrefParam. + +\subsection{GetLowHighPrefParam} +\begin{verbatim} +void GetLowHighPrefParam(char *name, double *low, double *high, + double *pref) +\end{verbatim} + +This procedure retrieves the information stored by +NewLowHighPrefParam. If the parameter is not found, the error code is +NotFound. + +\subsection{GetLowHighPrefConc} +\begin{verbatim} +void GetLowHighPrefConc(char *name, double charge, double *low, + double *high, double *pref) +\end{verbatim} + +This procedure is similar to GetLowHighPrefConc. + +\subsection{GetInitParam} +\begin{verbatim} +void GetInitParam(char *name, double *val) +\end{verbatim} + +The procedure retrieves the information stored by NewParameter, i.e. the +initial value for the parameter. The error +code is NotFound if the parameter {\tt name} has not been defined. + +\subsection{GetDeltaParam} +\begin{verbatim} +void GetDeltaParam(char *name, double *val) +\end{verbatim} + +This routine is similar to GetInitParam, but it retrieves the initial +step length for the parameter. + +\subsection{GetDeltaConc} +\begin{verbatim} +void GetDeltaConc(char *name, double charge, double *val) +\end{verbatim} + +This routine is similar to GetDeltaParam. + +\subsection{GetCurrentReaction} +\begin{verbatim} +int GetCurrentReaction(void) +\end{verbatim} + +The function returns the number of the reaction being parsed. + +\subsection{NoOfReact} +\begin{verbatim} +int NoOfReact(void) +\end{verbatim} + +The return value is the number of reactions parsed. Notice that +bidirectional reactions count only as one reaction! + +\subsection{SumCoeff} +\begin{verbatim} +double SumCoeff(int react_no, int side) +\end{verbatim} + +The routine sums up the coefficients in reaction {\tt react{\_}no}. +The argument {\tt side} should be 1 if the summing should be the +left-hand side, otherwise it will be the right-hand side. + +\subsection{IsSpecInReact} +\begin{verbatim} +int IsSpecInReact(int react_no, char *name, double charge, + double *coeff) +\end{verbatim} + +The function returns 1 if the species {\tt name(charge)} is found in +reaction {\tt react{\_}no}. The total coeffient is also returned. + +\subsection{NewParameter} +\begin{verbatim} +void NewParameter(char *name. double init_val) +\end{verbatim} + +The routine declares a new parameter (used in continuations) with the +name {\tt name}. The initial value of the parameter is given by the +parameter {\tt init{\_}val}. + +The error code is ParamAlready is the parameter has already been +declared, TooManyParam indicates there is no space for the parameter, +and NoError indicates that the call was succesful. + +\subsection{NewDeltaParam} +\begin{verbatim} +void NewDeltaParam(char *name, double delta) +\end{verbatim} + +The routine stores a new step size for the parameter {\tt name}. + +\subsection{NewDeltaConc} +\begin{verbatim} +void NewDeltaConc(char * name, double charge, double delta) +\end{verbatim} + +Similar to NewDeltaParam, but the parameter is given by {\tt name} and +{\tt charge}. + +\subsection{NewParamConc} +\begin{verbatim} +void NewParamConc(char *name, double charge, double init_val) +\end{verbatim} + +Similar to NewParam, but the parameter is given by {\tt name} and +{\tt charge}. + +\subsection{NumOfParameter} +\begin{verbatim} +int NumOfParameter(void) +\end{verbatim} + +The function returns the number of continuation parameters declared so +far. + +\subsection{GetParamNo} +\begin{verbatim} +void GetParamNo(int no, char *name, double *charge, int *form) +\end{verbatim} + +The routine finds parameter number {\tt no}. If {\tt form} is 2, then +the parameter is a species (and {\tt charge} is used), 1 indicates a +ordinary parameter, and 0 an error. + +\newpage +\section{Data type SymbMath} +\label{symbmath} +The concrete data type SymbMath is capable of handling expressions in +a symbolic way. The library is defined by the file {\tt symbmath.h}. + +The goal has been to create a general-purpose expression handler, \ie +a library which can do the common mathematical manipulations. Common +manipulutions are basic operators (\eg addition), functions (\eg +$\sin$), and differentiation. + +The expressions are implemented as binary tree. Some simplifications +are also done, but these are ``invisible'' to the user, \ie they are +called implicitly. + +Expressions (or trees) have to be declared by the user. Let {\tt t} +be the name of the tree, which have to be declared. The declaration +{\tt Tree t;} will be sufficient. Before +the use of the tree, the tree has to be created or allocated, see +section \ref{treecreate}. + +The library handles two kind of ``values''. They are constants and +variables. Constants are just +floating-point numbers (of the type {\tt double}). The variables are +strings of characters. +Note, that there is no check wheather the characters are printable or +not. + +\subsection{TreeGetError} +\begin{verbatim} +int TreeGetError(void) +\end{verbatim} + +This is the error handler routine of the library. The error codes are +defined as macros, and they can +be used when the SymbMath library is included. The following error +codes are defined: + +\vspace{0.2cm} +\begin{center} +\begin{tabular}{ll} +\hline + Error & Description \\ \hline + NoError & no error \\ + NoEval & could not evaluate tree \\ + NoTree & no tree allocated \\ +\hline +\end{tabular} +\end{center} +\vspace{0.2cm} + +\subsection{TreeCreate} +\label{treecreate} +\begin{verbatim} +Tree TreeCreate(void) +\end{verbatim} + +This operation creates a tree, \ie allocates the right portion of +memory and returns a pointer to it. The operation always leave a +NoError code. + +\subsection{TreeAdd, TreeSub, TreeMul, TreeDiv, and TreePow} +\begin{verbatim} +void TreeAdd(Tree t1, Tree t2) +void TreeSub(Tree t1, Tree t2) +void TreeMul(Tree t1, Tree t2) +void TreeDiv(Tree t1, Tree t2) +void TreePow(Tree t1, Tree t2) +\end{verbatim} + +These five operations perform the basic five arithmetic operations, \ie +$t1 = t1 op t2$. +The error code is always set to NoError. + +\subsection{TreeSign} +\begin{verbatim} +void TreeSign(Tree t) +\end{verbatim} + +This operation changes the sign of the expression given by $t$, \ie $-t$. + +\subsection{TreeAssignConst} +\label{treeassign} +\begin{verbatim} +void TreeAssignConst(Tree t, double val) +\end{verbatim} + +This function sets a tree equal to a constant ({\tt val}). The function +semantic is much like $t = \mbox{{\tt val}}$. The function always +returns NoError. + +\subsection{TreeAssignVar} +\begin{verbatim} +void TreeAssignVar(Tree t, char *name) +\end{verbatim} + +The function is similar to {\tt TreeAssignConst}, see section +\ref{treeassign}. Instead of a constant, the tree is assigned to a +variable, \ie the semantic is $t = \mbox{{\tt name}}$. + +\subsection{TreeSubstVar} +\begin{verbatim} +void TreeSubstVar(Tree t, char *name, double val) +\end{verbatim} + +The function substitutes all occurences of the variable {\tt name} in +the tree {\tt t} with the value {\tt val}. If the variable is not +in the tree, the tree is not changed. + +\subsection{TreeDerive} +\begin{verbatim} +void TreeDerive(Tree res, Tree t, char *name) +\end{verbatim} + +This operation differentiates the expression with respect of the +variable {\tt name}. The result of the differentiation is returned +in {\tt res}. The function will always return NoError as error code. + +\subsection{TreeEval} +\begin{verbatim} +double TreeEval(Tree t) +\end{verbatim} + +This function tries to evaluate the expression {\tt t}, \ie simplify +it to a constant. If it is not possible, then the error code is +NoEval, otherwise NoError. If it was not possible +(a variable is in the tree), the returned value is undefined. + +\subsection{TreePrint} +\begin{verbatim} +void TreePrint(Tree t, int mode, FILE *output) +\end{verbatim} + +This routine prints the tree {\tt t} to the file {\tt output}. +The tree is printed to the screen, if {\tt output} is set to +{\tt stdout}. The parameter {\tt mode} determines +how the output is going to look like. At the moment three modes are +supported. + +\vspace{0.2cm} +\begin{center} +\begin{tabular}{ll} +\hline + mode & Description \\ \hline + 1 & Fortran-77 \\ + 2 & Pascal \\ + 3 & ANSI C \\ +\hline +\end{tabular} +\end{center} +\vspace{0.2cm} + +\subsection{TreeCpy} +\begin{verbatim} +void TreeCpy(Tree t, Tree res) +\end{verbatim} + +This operation makes an exact copy of {\tt t} and places it in {\tt + res}, \ie the operation is {\tt res} = {\tt t} + +\subsection{TreeKill} +\begin{verbatim} +void TreeKill(Tree t) +\end{verbatim} + +This is the opposite of {\tt TreeCreate}. The operation deallocates a +tree. + +\subsection{TreeSubstTree} +\begin{verbatim} +void TreeSubstTree(Tree t, char *name, + Tree value) +\end{verbatim} + +This routine is analogue to {\tt TreeSubstVar} but instead of a value +an expression is substituted. + +\subsection{TreeApplyFunc} +\begin{verbatim} +void TreeApplyFunc(Tree *t, Function func) +\end{verbatim} + +This function applies a given function to the expression hold by {\tt + t}. The functions available are: {\tt Exp}, {\tt Sin}, {\tt Cos}, +{\tt Tan}, {\tt Ln}, {\tt Log}, {\tt Cosh}, {\tt Sinh}, {\tt Tanh}, +{\tt Asin}, {\tt Acos}, {\tt Atan}, {\tt Acosh}, {\tt Asinh}, and {\tt + Atanh}. + +\newpage +\section{Module CodeCall} +This module is implemented by two files, {\tt codecall.h} and +{\tt codecall.c}. There is only one procedure +in the module and it is CodeGenCall. It has the function head: +\begin{verbatim} +void CodeGenCall(int mode) +\end{verbatim} + +The implementation of CodeGenCall includes {\em all} code generators. +Each code generator has its one +file, which makes it easy to organise. The parameter {\tt mode} +determines which code generator is +called. Pseudo code of the function is: +\begin{verbatim} +case mode of + 1 : call code generator 1 + ... + n : call code generator n +\end{verbatim} + +Before calling the code generator there will be opened the files +which the generator is going to use. But this can the done otherwise +(let the code generator open the files). + +\newpage +\section{Grammar, semantic action, \etc} +In this section I will explain the grammar, the parser and the lexical +analyser. If a future programmer will charge anything in these three +parts, he (or she) is asked to contact me first. + +\subsection{The Grammar} +The grammar is a LALR(1)-grammar. That means that programs like {\em yacc} can +generate a parser directly from it. The grammar is made so much +left-recursive as possible. + +The parser is found in {\tt kc.y} while the lexical analyser is found +in {\tt kc.l}. + +\subsection{The parser} +The parser is generated by {\tt yacc} directly from the grammar. A +good and general book on {\tt yacc} is \cite{LexYacc}. +There are inserted semantic actions into the grammar. + +Not all the semantic actions are using the parser stack. The number of +actions not using the stack is minimal. They are using +local variables instead. These variables are: + +\vspace{0.2cm} +\begin{center} +\begin{tabular}{lll} +\hline + Variable & Type & Function \\ \hline + {\tt name} & {\tt char *} & storage of strings, misc.\ names \\ + {\tt charge} & {\tt double} & charge of species \\ + {\tt coeff} & {\tt double} & coefficient in reaction \\ + {\tt flag} & {\tt char} & flag, used in various situations + \\ + {\tt lineno} & {\tt int} & contains the line number in the + input \\ +\hline +\end{tabular} +\end{center} +\vspace{0.2cm} + +The parser stack is declared by a union in the file containing the +grammar and the semantic actions. This union contains the following fields: + +\vspace{0.2cm} +\begin{center} +\begin{tabular}{lll} + \hline + Field & Type & Description \\ \hline + {\tt dval} & {\tt double} & misc.\ floating-point values \\ + {\tt oper} & {\tt char} & operators in expressions \\ + {\tt name} & {\tt char *} & misc. names read by the lexical analyser \\ + {\tt flag} & {\tt int} & flag, used in various situations \\ + {\tt compound} & {\tt comp} & a compound\footnote{This is a + structure with three fields: {\tt name}, {\tt charge}, and {\tt concs}.} \\ + {\tt tree} & {\tt Tree} & expression \\ + {\tt func} & {\tt Function} & function \\ +\hline +\end{tabular} +\end{center} +\vspace{0.2cm} + +It is recommended that the programmer uses the parser stack (\ie the +union) and not some global variables. + +\subsection{The lexical analyser} +The lexical analyser is generated by {\tt lex}. Almost all actions are just +returning a token value. + +\newpage +\section{Code generation} +\label{codegen} +When all input have been parsed and stored in the various tables, the +code generator produces the output (the code). But since almost any +code generator share some common code, a special module has been +written. The name of the module is {\tt codegen.c}. + +The module declares a number of variables, namely + +\vspace{0.2cm} +\begin{center} +\begin{tabular}{ll} +\hline +Name & Description \\ \hline +v & rate expressions \\ +con & constraints \\ +jacobi & jacobian matrix (1st derivatives) \\ +hess & the hessian tensor (2nd derivatives) \\ +keld & 3rd derivatives \\ +\hline +\end{tabular} +\end{center} +\vspace{0.2cm} + +They are all defined as arrays or arrays of arrays of tree, see +section \ref{symbmath}. + +\subsection{InitCodeGenVar} +\begin{verbatim} +void InitCodeGenVar(int n, int m) +\end{verbatim} + +This is the first routine to be called by a code generator. The +routine allocates space for the variables discussed in section +\ref{codegen}. The argument {\tt n} is the number of dynamical +variables and {\tt m} is the number of constraints. + +\subsection{GenerateRateExpr} +\label{CodeGen:GenRateExpr} +\begin{verbatim} +void GenerateRateExpr(int mode, int ngrid, int mgrid, int boundary) +\end{verbatim} + +This function calculates all the rate expressions and constraints. If +{\tt mode} is 1, it is ordinary kinetics, while 2 is a +reaction-diffusion system. The arguments {\tt ngrid} and {\tt mgrid} +is the number of grid points for the reaction-diffusion system. The +last argument {\tt boundary} is 1 if no-flux and 2 if periodic +boundary conditions. + + +\subsection{GenerateJacobi} +\begin{verbatim} +void GenerateJacobi(int mode, int ngrid) +\end{verbatim} + +This routine finds the Jacobian matrix from the rate expressions. The +parameters are the same as for GenerateRateExpr, see subsection +\ref{CodeGen:GenRateExpr}. + + +\subsection{GenerateHessian} +\begin{verbatim} +void GenerateHessian(void) +\end{verbatim} + +This routine is computing the elements of the hessian tensor, \ie + +\[ + H_{ijk} = \frac{\partial^2 f_i}{\partial x_j \partial x_k}. +\] + +\subsection{GenerateKeldian} +\begin{verbatim} +void GenerateKeldian(void) +\end{verbatim} + +The routine is computing the elements of the tensor: + +\[ + K_{ijkl} = \frac{\partial^3 f_i}{\partial x_j \partial x_k \partial + x_l}. +\] + +\newpage +\section{Code generators} +This section documents the code generators already in action and how +to write a new one. I will claim that is not difficult to write a new +one, and I will give some hints. + +\subsection{Writing new code generators} +The most obvious extension of the program is properly new code +generators. This section will describe how to write one. Additional +information is found in section \ref{codegen}. + +The code generator is the back-end of the system. It is the final step +in transforming the input into the desired output. After the parsing, +the chemical model is put into various tables. The way to get the +information out of the tables is defined in section \ref{tableman}. +During the code generation some symbolic manipulation of expression +can be needed, see section \ref{symbmath}. + +Examples of code generators can be found in the files {\tt kgode.c} +and {\tt finn.c}. + +The exists some common constructions in every code generator, which I +will show below. Beside them, I have written a few routines which do +some common work. They are described in section \ref{codegen}. + +Almost all code generators will have some +construction in common. I will show them and give some possible solution. + +The first construction is ``for all reaction''. This can be made by +\begin{verbatim} +for(i=1;i<=NoOfReact();i++) { + ... +} +\end{verbatim} +Any reference to the reaction is done directly the $i$, \eg +{\tt GetReactNo(i-1)}. + +Similar to the previous, the construction ``for all species'' can be made by +\begin{verbatim} +for(i=1;i<=NoOfSpec();i++) { + ... +} +\end{verbatim} +There is one remark about this approach. If the code generator is +going to use the species (i.e. species number $i$) a construction +like {\tt GetSpecNo(i, ...)} is appropriate. + + +\subsection{KGode} +\begin{verbatim} +void KGode(FILE *ccode, FILE *hcode, int mode) +\end{verbatim} + +This code generator is the largest and the most used by many users. It +generates code for simulating chemical reactions and solving ordinary +differential equations. + +The two file handlers ({\tt ccode} and {\tt hcode}) points to the +files {\tt model.c} and {\tt model.h}. + +The meaning of the {\tt mode} parameter is found in the table below. + +\vspace{0.2cm} +\begin{center} +\begin{tabular}{rl} +\hline +\hfill Value & Description \\ \hline +1 & Ordinary differential equations and chemical kinetics +\\ +2 & Reaction-diffusion equations \\ +3 & Shifting between sets of equations \\ +\hline +\end{tabular} +\end{center} +\vspace{0.2cm} + +Mode 3 uses a number of internal routines, and they are documented +below. These routines are operations on a data type called a base name +table which keeps track of the different sets of equations. + +The records of a base name table is simply a name and pointers +(implemented as indices) to the rate expressions. + +\subsubsection{StripName} +\begin{verbatim} +void StripName(char *name, int *part) +\end{verbatim} + +A name of dynamical variable consists of a name followed by a number. +The name is called the base name. The number shows +which set of equation, the actual differential equation is part of. +StripName determines the base name and which set of equations it +belongs to. The argument {\tt name} is both input and output, and {\tt + part} is zero, if no base name fits. + +\subsubsection{BuildBaseTable} +\begin{verbatim} +void BuildBaseTable(void) +\end{verbatim} + +The base name table is build up by this routine. + +\subsubsection{GetIndex} +\begin{verbatim} +int GetIndex(char *name, int part) +\end{verbatim} + +The routine returns an index to the rate expression array (the global +variable {\tt v}, see section \ref{codegen}), where the dynamical +variable {\tt name} in set {\tt part} is found. + +\subsubsection{NumOfBaseNames} +\begin{verbatim} +int NumOfBaseNames(void) +\end{verbatim} + +The function returns the number of base names stored in the base name +table. It is very useful in loops. + +\subsubsection{GetBaseNameNo} +\begin{verbatim} +void GetBaseNameNo(int i, char *name) +\end{verbatim} + +The routine copies the base name number {\tt i} into {\tt name} as +found in the base name table. + + +\subsection{Finn} +\begin{verbatim} +void Finn(void) +\end{verbatim} + +This code generator is an example of a code generator which does not +generate code. On the other hand it computes the jacobian matrix +numerically and calcutes the eigenvectors and eigenvalues. + +The code generator is heavily using some numerical libraries, namely +{\tt eigen}, {\tt complex} and {\tt matrix}. They are documented in +\cite{kk:numlib94}. + + +\subsection{KNcont} +\begin{verbatim} +void KNcont(FILE *code) +\end{verbatim} + +The code generator is used together with Keld Nielsen's continuation +program written in Pascal. + + +\subsection{Waves} +\begin{verbatim} +void waves(FILE *hcode, FILE *ccode, FILE *icode) +\end{verbatim} + +The code generator is used together with Kenneth Geisshirt's +simulation programs for reaction-diffusion systems. + + +\newpage +\section{Module Misc} +I have written a small module called Misc. The module is defined by +the include file {\tt misc.h}. The module consists of a number of +routines which do not fit into other modules. + +\subsection{GetAndPrintConst} +\begin{verbatim} +void GetAndPrintConst(char *name, char *text, int type + double def, FILE *output, int mode) +\end{verbatim} + +The procedure find the value of the constant {\tt name}, prints an +assignment statement on file {\tt output} of the form: {\tt text} +assignment-operator value. The assignment-operator depends on the +{\tt mode}: Fortran (1), Pascal (2), and C (3). If the constant has +not been defined a default value is used ({\tt def}). The procedure +will also print the appropriate line seperator character according to +the mode. + +The routine is {\em very\/} useful when one wants to print a number of +constants in a code generator, \ie it is used to generate the +initialising code for a simulation program. + +\subsection{Fact} +\begin{verbatim} +int Fact(int n) +\end{verbatim} + +This is simply just the factorial, \ie $n!$. + + +\subsection{StringAlloc} +\begin{verbatim} +char *StringAlloc(void) +\end{verbatim} + +The routine allocates space for a string of a given length (see the +file {\tt config.h}). + +\subsection{StringFree} +\begin{verbatim} +void StringFree(char *str) +\end{verbatim} + +The routine frees the space used by the string {\tt str}. + + +\newpage +\section{Advices and hints} +This section gives some advices and hints on the work with {\tt kc}. +The work is seen from the programmer's view and not the user's. + +It should be noted that the program is written in ANSI C. This may +course trouble on systems without a ANSI-C compiler (old systems may +have only a K{\&}R-C). + +The installation is very simple for many platforms. There is a script +called {\tt kc-inst} which does the work. Run the script without any +arguments to get some help. + +The package is fairly easy to port. I have it running on HP-UX +(Hewlett-Packard), Linux (Intel based computers), +MS-DOS (Intel based computers), ConvexOS, IRIX (Silicon Graphics), and +Ultrix (Digital). With a standard C-compiler like {\tt gcc}, there +should be no problems. + +The program is configurated in {\tt config.h}. A number of macros is +defined, and the table below gives a short introduction to them. + +\vspace{0.2cm} +\begin{center} + \begin{tabular}{ll} + \hline + Macro & Description \\ \hline + VERSION & A string giving the version number. \\ + STRING{\_}LENGTH & The length of strings used. \\ + MALLOCTYPE & The type used by the standard function {\tt free}. \\ + \hline + \end{tabular} +\end{center} + +The macro {\tt {\_}PLATFORM{\_}}* is usually set up in the makefile, +and it gives which platform (operating system, compiler, \etc) being +used. + + +\newpage +\bibliography{kc-ref} +\end{document} diff --git a/docs/kci-man.html b/docs/kci-man.html new file mode 100644 index 0000000..9334a59 --- /dev/null +++ b/docs/kci-man.html @@ -0,0 +1,363 @@ + + + + + + +Users' Manual to KCI + +

Users' Manual to KCI

+ +

Welcome to the KCI program. KCI is an abbriviation of Kinetic Compiler +and Integration and the main purpose of of the program is to simulate +chemical reactions and make that task easy for chemists so they do not +have to use to much time with computers.

+ +

The program is a joint project between several people. The two +major programmers are Keld Nilsen +at Department of Chemistry, University +of Copenhagen and +Kenneth Geisshirt at Department of +Life Sciences and Chemistry, Roskilde University. A number of +people has donated code or accepted that their code is distributed +together with KCI.

+ +

The main features of KCI are listed below:

+ +
    +
  • Chemical reactions written in a "natural" fashion. +
  • Couple reactions and ordinary differential equations. +
  • Do dynamical simulations. +
  • Do continuatoins. +
  • Do sensitivity analysis. +
  • Calculating various quantities from the mechanism. +
  • Use stoichiometric constains. +
  • Output is readable by GNUplot. +
  • Ported to many platforms including DOS, +Linux, HP-UX, +IRIX, Ultrix, AIX. +
  • Has been used both in research and teaching undergraduate students. +
+ +
+

Table of Contents

+ +

The first thing you have to do is to install KCI. There are two different +ways, depending on whether you are using DOS or +a Unix variant.

+ +

The basic things are reviewed the these first sections:

+ + +

An input file to KCI consists of five sections. They are described +more closely in the next sections.

+ + +

To KCI there comes a number of "code generators". Each "code generator" +does some numerical analysis. At the moment there are the following +"code generators":

+
    +
  • Dynamical simulation using KKsolver. +
  • Dynamical simulation using CVode. +
  • Continuation using mcont. +
  • Calculating various quantities. +
  • Perform sensitivity analysis. +
+ +

If you are in a hurry and just what to see how an input file looks +like, we have included one for you. You find it at +the end of this manual.

+ + +
+

Installation under DOS.

+ + +
+

Installation under a Unix variant.

+

Installation under Unix variants are simple. You should do as follows.

+ +
    +
  • Download the file kc.tar.Z. +
  • Change to a temporary directory and move the file to it. +
  • Unpack the file, i.e.
    + +uncompress kc.tar.Z
    +tar xvf kc.tar
    +     +
  • Change to the kc directory which has just been created. +
  • Decide where you want KCI to be installed (let us call it +prefix. On many systems, /usr/local would be a +good place. +
  • Make now two directories - if they do not exists already - namely the +two direactories prefix/bin and prefix/num. +
  • Run now the compilation script kc-inst with two +arguments: kc-inst prefix PLATFORM. The argument +PLATFORM is the name of your system. If you run +kc-inst without arguments, it will list the supported platforms. +
+ +
+

Comments

+

The input file to KCI may contain comments which are not used by +other than the user.

+ + +
+

Names, numbers, species, and +concentrations

+ +

The four above quantities are essential for the KCI program. We will +briefly explained them here, and you will find examples of their use in +other sections.

+ +
+
Names
Names are a letters followed by a sequency of letters and/or +digits. Examples of valid names are:

+ +X
+y653X
+HelloWorld
+
+Note that capital letters and non-capital letters are disticted. + +
Numbers
Numbers are written as you are used to when you are working +with computers. Examples of valid numbers are:

+ +42
+-3.1415926535
+1.0e-4
+3.00e6
+
+Note that when you are typing in numbers in scientific notation, you have +to write it with a decimal-point, i.e. 5e8 is not a +valid number. + +
Species A species is almost the same as a name, i.e. a valid +name is also a valid species. But chemical compounds may have charges (i.e. +being an ion) or it can be a radical. For ions and radical the "charge" +comes after the name in parentheses. The charge for a radical is period +(.). Examples of valid species are:

+ +H2O
+SO4(-2)
+H(+)
+Cl(.)
+
+Please note that the charge of -1 and +1 is written +as - and +, respectively. Notice that +H(+) and H(.) are two different species. + +
Concentrations Concentrations are written the way many chemists do, +i.e. the species surrounded by brackets. Examples of valid concentrations are: +

+ +[H2O]
+[SO4(-2)]
+[H(+)]
+[Cl(.)]
+
+ +
+
+ + +

Expressions.

+

Expressions are used all over the input file for KCI. For people used +to computers, expressions are easy. In this section we review how to use +them.

+ +

Let expr1 and expr2 be two +expressions. From these two expressions we can form a new expression +expr as (the -> should be read as "can be"):

+ +

+expr -> expr1 oper expr1
+expr -> func ( expr1 )
+expr -> - expr1
+expr -> ( expr1 )
+expr -> name
+expr -> concentration
+expr -> number +

+ +

The oper is a binary operator, and it can be one of +the following: ** and ^ (power-raising), +* (multiplication), / (division), + +(addition) or - (subtraction).

+ +

The func is a function application, i.e. a unary operator. +It can be one of the following: exp, log, +ln, sin, cos, tan, +asin, acos, atan, sinh, +cosh, tanh, asinh, acosh, +or atanh. Please notice that there is no square root; it can be +obtained by using the power-raising operator.

+ +

A word of guidance: use more parenthesis that you otherwise would do +on a piece of paper. The expression like 1/x+1 is interpreted +as 1 plus 1 divided by x.

+ +

A few valid expressions follow:



+ +5*x
+log([H(+)])+2
+exp(log(sin(x)))
+-(x+1)
+x**2+y^3
+ + +
+

Constants

+

Constants has two purposes in KCI. First, they set up how the computations +are going to be performed, and second, they are can be used to write more +clear and easily read input file. The first group of constants depend +on the code generator so they are explained together with each code +generator.

+ +

To define a constant is very simple. The syntax is name = expr; +- it is very important to remember the semicolon. Names + and expressions are explained elsewhere. If +the expression on the right hand side contains constants, they must be +defined previously. Below you see some examples of definitions of constants: +

+ +

+ +pi = 3.1415926535;
+everything = 42;
+R = 8.31415;
+T = 300;
+A = 1.1e8;
+Ea = 2000.1
+k = A*exp(-Ea/(R*T));
+ +
+ + +

Control statements.

+

Control statements are used to control different parts of the +KCI system. A control statement always begins with a hash mark +(#). The control statements are listed below.

+ +
+
PRINT
The #print control statement controls what +is written as output. After the #print comes a comma sepatated +list of concentrations and/or +dynamical variables. For example, the statement below +will make KCI only printout the values of x and y. +

+ +#print x, y;
+ + +
PARAMETER
+
+ +

Reactions and ODEs.

+

The reactions are of course the most interesting part of the input +file for KCI. In this section we will discuss two things: reactions and +ordinary differential equations (ODEs). As you may know, chemical reactions +are mathematically described as ordinary differential equations of first +order, and the simulation of reactions is the same as solving differential +equations.

+ +

You can as user of KCI use chemical reactions or ODEs to desribe your +problem. And you can even mix reactions and ODEs. This is in some cases +a very good idea, e.g. if you want to include the temperature as a +variable in your model.

+ +

We will refer to a dynamical variable as a variable given by an ODE. +Dynamical variables have to follow the rules of names. +

+ +

Below you will find an example of a reaction. First, there is a number +(23) which is the reaction number. Reaction numbers are integer +number and must be unique. The reaction number is +followed by a colon (:). Then we have a list of the reactants. +Reactants are species and there may be a stoichiometric +coefficient before them. The symbol -> is KCI's symbol for a +reaction arrow. Reaction arrows may be either -> (forward +reaction) or <-> (forward and backward reactions). After the +reaction arrow there comes a list of products and the reaction is ended by +a semicolon (;). The next symbol is k> which +means the rate constant for the forward reaction. The symbol for the +backward reaction is k<. The values of the rate constants is +an expression. +

+ +23: 2 Na(+) + SO4(-2) -> NaSO42; k> = 1.0e-7; +
+ + + +

+

A complete input file.

+

Below you find a complete input file. The file can be used to +do a dynamical simulation of bromate oxidation of cerium in an +open system.

+

+ +/* Belousov-Zhabotinsky reaction */
+/* Model: the Oscillatory Bromate Oxidation of Cerium in open systems */
+/* Hynne, Sorensen, Nielsen, 1990 */
+
+mixed=2;
+
+kf1 = 2.0;
+kf2 = 3.0e6;
+kf3 = 42.0;
+kf4 = 3.0E3;
+kf5 = 0.104;
+kf6 = 0.08;
+kf7 = 0.14;
+
+j0 = 4.7096E-5;
+
+stime = 0; dtime=1; etime = 16000; epsr = 1.0e-04; epsa = 1.0e-14;
+
+ref= 3;
+
+#print [Ce(+4)];
+
+11: HBrO2 -> P ; k> =j0;
+12: Br(-) -> P ; k> =j0;
+13: Ce(+4) -> P ; k> =j0;
+14: HBrO -> P ; k> =j0;
+
+
+1: BrO3(-) + Br(-) + 2H -> HBrO2 + HBrO ; k> =kf1;
+2: HBrO2 + Br(-) + H -> 2HBrO ; k> =kf2;
+3: BrO3(-) + HBrO2 + H -> 2HBrO2 + 2Ce(+4) ; k> =kf3;
+4: 2HBrO2 -> HBrO + BrO3(-) + H ; k> =kf4;
+5: Ce(+4) -> 0.25Br(-) ; k> =kf5;
+6: HBrO -> Br(-) ; k> =kf6;
+7: HBrO -> P ; k> =kf7;
+
+[P] = 0; [H] = 0.7; [BrO3(-)] = 0.012;
+
+[HBrO2](0) = 2.810E-8;
+[Br(-)](0) = 0.20968E-6;
+[Ce(+4)](0) = 0.19058E-6;
+[HBrO](0) = 0.12369E-6;
+ + + + + +
+This manual was last updated 18 July 1996 by + Kenneth Geisshirt. + + diff --git a/docs/kci.1 b/docs/kci.1 new file mode 100644 index 0000000..225ee5e --- /dev/null +++ b/docs/kci.1 @@ -0,0 +1,78 @@ +.TH KCI 1l "2 October 1994" +.UC 4 +.SH NAME +kci - Kinetic Compiler and Integrator +.SH Synopsis +.B kci +.I file +.br +.SH DESCRIPTION +.I Kci +is a front-end to the +.I Kinetic Compiler + . +.PP +.I Kci +transforms a set of chemical reactions and ordinary differential equations +into a program which calculates the concentrations and values of the +dependent variables. Different options and parameters to the program is +given as constants in the input file. +.PP +The parameters avaiable are shown below. The default value is wriiten +in parenthesis. +.PP + +.B stime +Start time (0). + +.B etime +End time (200). + +.B dtime +Interval between printouts (2). + +.B epsa +Absolute precision (1.0e-10). + +.B epsr +Relative precision (1.0e-5). + +.PP +The +.B method +parameter decides which numerical integration to be used. In the +present version the following can be used. + +1. +.I Calahan + +2. +.I 4th order Rosenbrock + +3. +.I 4th order Runge-Kutta + +4. +.I 5th order generalised Runge-Kutta + +5. +.I As 2 with implicit time + +7. +.I As 4 with implicit time + + + +.SH FILES +.B +kc/docs/kc-man.tex +The user's manual to the system. +.B +kc/test/* +A lot of examples. + +.SH SEE ALSO +There exists a user's manual which should come together with this file. + +.SH AUTHOR +Keld Nielsen (kn@kiku.dk) and Kenneth Geisshirt (kneth@osc.kiku.dk) diff --git a/docs/kin.tex b/docs/kin.tex new file mode 100644 index 0000000..a359db3 --- /dev/null +++ b/docs/kin.tex @@ -0,0 +1,180 @@ +\documentstyle{article} +\author{Kenneth Geisshirt} +\title{The {\tt kin} precompilers} +\date{4 August 1992} +\begin{document} +\maketitle +\section{Preface} +The {\tt kin} programs are precompilers, which translate chemical equations +into runnable programs. The generated program 'solves' the chemical system. + +The precompilers are written in ANSI-C, so porting them are easy (recompile them). +The output is fairly difficult, because it is HP-Pascal code (difficult for people, who +don't have a HP-Pascal compiler on their system). + +The precompiler transforms the chemical model into differential equations using the +mass-action law. The system consists of two programs. The first one is {\tt kinc} +which generates velocities and jacobians. The other is {\tt kins} which does +the same plus generates the second order tensor. + +The integration finds the concentrations with respect of time. + +A older version of the system is running as an interactive PC-program (rather, +running on a Partner from Regnecentralen). This version can also do graphics +manipulations on the data obtained from the integration process. + +\section{How to run it} +The requirements to the computer, which is going to run {\tt kin} is, that it +has a C compiler (ANSI compatible) and a HP-Pascal. Assuming that the computer +does not have a HP-Pascal, then the requirements are a C-compiler and a +Pascal-to-C translator, e. g. {\em p2c} by Daves Gillespie \footnote{The system +installed (and running) on {\em tiger} at PICHT is of the later type.}. In the following +it is assumed that no Pascal compiler is present. + +Running the {\tt kin} system is a bit tricking at the moment, because I don't know +the Unix operating system well enough. But the following procedure can be used. +\begin{enumerate} + \item You have to be in the right directory. In this context the right directory + is up to you, but you have to write it into the {\tt tkin} script (variable + {\tt MYPATH} contains the information). + The directory has to be a subdirectory to the one containing the integrator and + other vital files. The script doesn't have to be in either directories. + \item The system is now executed by the command {\tt tkin model}, where {\tt model} is + file containing your model. The integrator will be started as soon as the compilation + is done, so redirection is recommended. +\end{enumerate} + +\section{Minimal user's manual} +This section is not intented to be a full description of the system, but a brief introduction +so the reader should be able to use the system. + +The input format is straightforward (when you have tried it a few times). The model +consists of chemical equations, initial concentrations and linear constrains. The last +two sections are optional. Parameters can be defined every where in the 'source' +file. + +For further information on the input, I have written some small examples. These shows some of the +key points in the {\tt kin} system. + +\subsection{Equations} +All the equations are on the form: +\begin{verbatim} + number : A + B + ... -> Q + R + ... ; k> = number +\end{verbatim} +The first number is a positive integer, while the last number is a floating-point constant. +The colon after the first number have to be there, otherwise it is a syntax error. The reactants +and products are written in the usual way. Coefficients are naturally allowed. The names of the +species do not have anything to do with the real world; they are 'just' variables. Two kinds of +reactions are allowed. They are one-way reaction {\tt ->} and two-ways reaction {\tt <=>}. For two- +way reactions two rate constants must be supplied. The rate constants are written on the same line after a +semicolon. A {\tt >} denoted the reaction from left to right, while {\tt <} denotes the reaction from +righ to left. A space after {\tt >} and {\tt <} is very important. + +\subsection{Initial concentrations} +Initial concentrations are written after the equations. The default value is $0.0$, but the user can +request other values at $t=0$. The syntax is simple; it is: +\begin{verbatim} + [J](0) = number +\end{verbatim} +where {\tt J} is a species, and {\tt number} is a constant (can of course be a parameter). + +\subsection{Linear constrains} +The linear constrains in this version of {\tt kin} are very simple. As the name says, it is only +linear, and a constrain has the form: +\begin{verbatim} + [J] = number - [A] - ... +\end{verbatim} +Of course there can be coefficients before a concentration, but they have to be numbers. +Further, the concentrations on the right side can be omitted, i. e. +a concentration is constant at all time. + +\subsection{Parameters} +A parameter declaration has the form: +\begin{verbatim} + name = expr +\end{verbatim} +where {\tt name} is the symbolic name of the parameter, and {\tt expr} is a expression. The expression +is a general expression, i. e. the four mathematical operators can be used. There are some predefined +parameters. They are shown below. + +\begin{tabular}{llr} + Name & Description & Default value \\ + stime & start time & $0$ \\ + dtime & step length & $1$ \\ + etime & end time & $10$ \\ + epsr & relative error & $10^{-3}$ \\ + epsa & absolute error & $10^{-20}$ \\ + name & name of output file & "kinwrk.dat" +\end{tabular} + +The value of these parameters will be copied into the integrator, they and will therefore have +and an effect on the program. + +\subsection{Call of external functions} +The {\tt kin} system has a feature of calling external functions. The only +predefined function is {\tt arrh} which computes rate constants according +to the Arrhenius' formula. The form of a call of an external function is: +\begin{verbatim} + func <: p1, p2, ..., pn :>(0) +\end{verbatim} +where {\tt func} is the name of the function and {\tt pi} is the parameters +to the function. The result of the call is returned in the {\em first} +parameter, i. e. a call to the Arrhenius function will be: +\begin{verbatim} + arrh <: k, a, E, T :>(0) +\end{verbatim} + +An example of the format of external functions can be found in the file +{\tt arrh.c}, which is supplied with the {\tt kin} system. + +The use of external functions will cause a warning from {\tt p2c}, because +a parameter is not defined {\footnote{The warning is: {\tt Expected a +expression, found a semicolon}}}, but this warning can be ignored. + +\subsection{Comments} +Comments can be placed everywhere in the source file. The comments are in C- +style, i. e. they have the form: + +\begin{verbatim} + /* This is a comment */ +\end{verbatim} + +\subsection{Numbers} +There is a minor problem when using the system on {\em tiger}. The +{\em p2c} translator seems to have problem when translating double +precision floating-point numbers, e. g. {\tt 1.0L-1}. Don't use +them but use only normal numbers, e. g. {\tt 1.0E-1}. + +\subsection{Limits} +{\tt kin} has some limitations, especially in the number of reactions and species. The table below shows +these limitations. +\begin{tabular}{lr} + Reactions & 150 \\ + Species & 50 \\ + Reactants & 5 \\ + Constrains & 5 \\ + Species in constrains & 10 \\ + Parameters & 100 \\ + External function & 50 +\end{tabular} + +\section{Good and bad things} +The {\tt kin} has its advantages and its disadvantages. In this section I will shortly discuss some +of them. + +The disadvantages are: +\begin{enumerate} + \item Only mass-action law. + \item No ions and therefore no diffusion can be modeled. + \item The syntax of the constrains is not smart, and they can only be linear. + \item No equilibriums can be modeled directly, but only as fast two-way reactions. + \item Code generator is not easy to port (have to use strange translators). +\end{enumerate} + +The advantages are: +\begin{enumerate} + \item Easy syntax for chemical equations. It is must like ordinary mechanism. + \item Does the boring job, i. e. the chemist can do what is his job: making + chemical models \footnote{Boring work often leads to errors!}. +\end{enumerate} +\end{document} diff --git a/docs/lib-dep.fig b/docs/lib-dep.fig new file mode 100644 index 0000000..20dfa60 --- /dev/null +++ b/docs/lib-dep.fig @@ -0,0 +1,41 @@ +#FIG 2.1 +80 2 +2 4 0 1 -1 0 0 0 0.000 7 0 0 + 199 119 199 39 39 39 39 119 199 119 9999 9999 +2 4 0 1 -1 0 0 0 0.000 7 0 0 + 259 259 259 179 99 179 99 259 259 259 9999 9999 +2 4 0 1 -1 0 0 0 0.000 7 0 0 + 499 259 499 179 339 179 339 259 499 259 9999 9999 +2 4 0 1 -1 0 0 0 0.000 7 0 0 + 559 119 559 39 399 39 399 119 559 119 9999 9999 +2 4 0 1 -1 0 0 0 0.000 7 0 0 + 389 399 389 319 229 319 229 399 389 399 9999 9999 +2 1 0 1 -1 0 0 0 0.000 -1 1 0 + 0 0 1.000 4.000 8.000 + 119 119 179 179 9999 9999 +2 1 0 1 -1 0 0 0 0.000 -1 1 0 + 0 0 1.000 4.000 8.000 + 79 119 79 359 229 359 9999 9999 +2 1 0 1 -1 0 0 0 0.000 -1 1 0 + 0 0 1.000 4.000 8.000 + 179 259 299 319 9999 9999 +2 1 0 1 -1 0 0 0 0.000 -1 1 0 + 0 0 1.000 4.000 8.000 + 479 119 419 179 9999 9999 +2 1 0 1 -1 0 0 0 0.000 -1 1 0 + 0 0 1.000 4.000 8.000 + 519 119 519 359 389 359 9999 9999 +2 1 0 1 -1 0 0 0 0.000 -1 1 0 + 0 0 1.000 4.000 8.000 + 419 259 319 319 9999 9999 +2 1 0 1 -1 0 0 0 0.000 -1 1 0 + 0 0 1.000 4.000 8.000 + 339 219 259 219 9999 9999 +2 1 0 1 -1 0 0 0 0.000 -1 1 0 + 0 0 1.000 4.000 8.000 + 419 119 419 139 219 139 219 179 9999 9999 +4 0 0 12 0 -1 0 0.00000 4 12 104 259 359 Symbol mathematics +4 0 0 12 0 -1 0 0.00000 4 9 33 104 79 Parser +4 0 0 12 0 -1 0 0.00000 4 12 74 139 219 Table manager +4 0 0 12 0 -1 0 0.00000 4 12 83 439 79 Code generators +4 0 0 12 0 -1 0 0.00000 4 12 121 359 219 Code generator routines diff --git a/docs/lib-dep.ps b/docs/lib-dep.ps new file mode 100644 index 0000000..6637663 Binary files /dev/null and b/docs/lib-dep.ps differ diff --git a/docs/num-lib.tex b/docs/num-lib.tex new file mode 100644 index 0000000..d8bd5a9 --- /dev/null +++ b/docs/num-lib.tex @@ -0,0 +1,232 @@ +% Last updated: 5 Oct 1994 +\documentclass[12pt]{article} + +\newcommand{\ie}[0]{{\it i.e.\ \/}} +\newcommand{\eg}[0]{{\it e.g.\ \/}} +\newcommand{\diff}[2]{\frac{{\mathrm d}#1}{{\mathrm d}#2}} + +\setlength{\parindent}{0cm} +\setlength{\parskip}{0.1cm} + +\title{A Small Package of \\ Numerical Methods in ANSI C} +\author{Kenneth Geisshirt \and Keld Nielsen} +\date{5 October 1994} +\begin{document} + +\maketitle +\tableofcontents + +\section{Introduction} +\label{sec:Intro} + +This brief report documents the numerical libraries which we have +developed. The code is written in ANSI-C, \cite{CProgLan}. This fact +makes the code very portable, especially Unix based systems should be +able to run it. + +The library is purposed to be a general-purpose numerical library. +This means that there is routines for many different problems. + +The following sections describe each a library. The routines are +discussed, and general guidelines are given. The names of the +libraries are given in {\tt typewriting}, and this also gives the name +of the source and object files. + +The implementation presented here should not be consider to be advanced. +It is meant to be small and simple. It contains the routines which we +have found useful in our applications, which is mainly the simulation +of chemical reactions. + + +\section{Integration of functions} +\label{sec:InteFunc} + +The scope of the library called {\tt integr} is to evaluate definite +integration, \ie to compute + +\begin{equation} + \int_a^b f(x, \vec{\mu}) {\mathrm d}x, +\end{equation} +where $\vec{\mu}$ is a number of parameters. All the routines in the +library have the same structure. + +The function $f$ is assumed to be declared as + +\begin{verbatim} +double f(double x, double *mu) +\end{verbatim} + +The integration routines can be called as + +\begin{verbatim} +Inte(N, a, b, mu, &f) +\end{verbatim} +where {\tt N} is the number of sunintervals which should be used, {\tt + a}, {\tt b} and {\tt mu} correspond to $a$, $b$ and $\vec{\mu}$ +respectively, and of course {\tt f} is $f$. The function returns the +value of the integral as a double-precision value. + +There are three choices of integration methods available. {\tt Gauss5} +is a five-point Gaussian quadrature, {\tt Simpson} is the composite +Simpson's rule, and {\tt Trapez} is the composite trapezoid rule. + + +\section{Complex numbers} +\label{sec:complex} + +Many numerical applications are using complex numbers, and we provide +a small implementation in form of the {\tt complex} library. + +The complex numbers are given their own type. It is called {\tt + Complex}, and therefore a proper declaration of the complex number +$z$ is + +\begin{verbatim} +Complex z; +\end{verbatim} + +The real and imaginary parts of {\tt z} are address as {\tt z.re} and +{\tt z.im}, respectively. + + +\subsection{ComplexAssign} +\label{sec:ComplexAssign} +\begin{verbatim} +ComplexAssign(double x, double y, Complex *z) +\end{verbatim} + +This routines assign the complex number $z$ a value, namely $z = +x+\imath y$. + + +\subsection{ComplexAdd} +\label{sec:ComplexOper} +\begin{verbatim} +ComplexAdd(Complex a, Complex b, Complex *z); +ComplexSub(Complex a, Complex b, Complex *z); +ComplexMul(Complex a, Complex b, Complex *z); +ComplexDiv(Complex a, Complex b, Complex *z); +\end{verbatim} + +Depending on the routine, it computes either the sum, the difference, +the product or the quotient of the two number $a$ and $b$ and returns +the result in $z$. For {\tt ComplexDiv} the result is $\frac{a}{b}$ +and for {\tt ComplexSub} is $a-b$. + + +\subsection{ComplexNorm} +\label{sec:ComplexNorm} +\begin{verbatim} +double ComplexNorm(Complex z); +\end{verbatim} + +The function computes the norm of $z$. + + +\subsection{ComplexArg} +\label{sec:ComplexArg} +\begin{verbatim} +double ComplexArg(Complex z); +\end{verbatim} + +the function computes the argument of $z$. + + +\section{Eigenvalues} +\label{sec:Eigen} +In order to calculate eigenvalues and -vectors of general real +matrices, we have implemented one routine in the library {\tt eigen}. +An eigenvalue problem is the equation + +\begin{equation} +{\mathbf A}\cdot\vec{x} = \lambda\vec{x}, +\label{EigenEq} +\end{equation} +where ${\mathbf A}$ is a $n\times n$ matrix, $\vec{x}$ is +$n$-dimensional vector (called eigenvector) and $\lambda$ is a +complex number (called the eigenvalues). + +The routine has a very simple interface, namely + +\begin{verbatim} +void Eigen(int n, double **A, int maxiter, Complex *vals, Complex +**vecs) +\end{verbatim} + +The arguments are explained in the table below. + +\begin{center} + \begin{tabular}{|l|l|} + \hline + Argument & Description \\ \hline + {\tt n} & the dimension $n$ \\ + {\tt A} & a real $n\times n$ matrix \\ + {\tt maxiter} & the maximal number of iterations \\ + {\tt vals} & the $n$ eigenvalues packed as a vector \\ + {\tt vecs} & the $n$ eigenvectors packed as a matrix \\ \hline + \end{tabular} +\end{center} + + +\section{Ordinary differential equations} +\label{sec:ODEs} +In many physical applications one wants to solve ordirary differential +equations. We have implemented a library called {\tt odesolv} which is +a good tool. The library consists of a number of methods. Each method +is implemented as a subroutine, which take one step with a given +length. Each routine returns also an error estimate. + +The first group of routines take solves the equation + +\begin{equation} + \diff{\vec{x}}{t} = \vec{f}(\vec{x}), + \label{ODEauto} +\end{equation} +\ie a autononymous ordinary differential equation of 1st order. The +routines have a common interface, namely + +\begin{verbatim} +method(int n, double dt, double *x, double *xnew, double *err, + void (*f)(double *, double *), void (*jac)(double *)) +\end{verbatim} + +The arguments are summarised below. + +\begin{center} + \begin{tabular}{|l|l|} + Argument & Description \\ hline + {\tt n} & the dimension \\ + {\tt dt} & step length \\ + {\tt x} & $\vec{x}$ before the step \\ + {\tt xnew} & $\vec{x}$ after the step \\ + {\tt err} & the error estimate \\ + {\tt f} & a pointer to $\vec{f}$ \\ + {\tt jac} & a pointer to a function which computes the jacobian + \\ + \hline + \end{tabular} +\end{center} + +The argument {\tt f} is a pointer to a function, which first argument +is $\vec{x}$ and as second argument is $\vec{f}(\vec{x})$. The +argument {\tt jac} is a pointer to a routine, which computes the +elements of the jacobian matrix, \ie + +\begin{equation} + J_{ij} = \left. \frac{\partial f_i}{\partial x_j}\right|_{\vec{x}}. + \label{Jac} +\end{equation} + +The matrix is communicated through a global variable {\tt + jaccobi_matx} (the user must allocate it, but but define it). + +Not all the routines are using the jacobian matrix, and therefore this +argument may be omitted. + + +\section{Vectors and matrices} +\label{sec:VecMatx} + + +\end{document} + diff --git a/docs/psfig.tex b/docs/psfig.tex new file mode 100644 index 0000000..8f1b4d0 --- /dev/null +++ b/docs/psfig.tex @@ -0,0 +1,395 @@ +% Psfig/TeX Release 1.2 +% +% Archive users note: this is an out-of-date version, preserved because future +% versions are backwards incompatible. Use psfig.sty for the up-to-date +% version. +% +% dvips version +% +% All software, documentation, and related files in this distribution of +% psfig/tex are Copyright 1987, 1988 Trevor J. Darrell +% +% Permission is granted for use and non-profit distribution of psfig/tex +% providing that this notice be clearly maintained, but the right to +% distribute any portion of psfig/tex for profit or as part of any commercial +% product is specifically reserved for the author. +% +% $Header: psfig.tex,v 1.9 88/01/08 17:42:01 trevor Exp $ +% $Source: $ +% +% Thanks to Greg Hager (GDH) and Ned Batchelder for their contributions +% to this project. +% +\catcode`\@=11\relax +\newwrite\@unused +\def\typeout#1{{\let\protect\string\immediate\write\@unused{#1}}} +\typeout{psfig/tex 1.2-dvips} + + +%% Here's how you define your figure path. Should be set up with null +%% default and a user useable definition. + +\def\figurepath{./} +\def\psfigurepath#1{\edef\figurepath{#1}} + +% +% @psdo control structure -- similar to Latex @for. +% I redefined these with different names so that psfig can +% be used with TeX as well as LaTeX, and so that it will not +% be vunerable to future changes in LaTeX's internal +% control structure, +% +\def\@nnil{\@nil} +\def\@empty{} +\def\@psdonoop#1\@@#2#3{} +\def\@psdo#1:=#2\do#3{\edef\@psdotmp{#2}\ifx\@psdotmp\@empty \else + \expandafter\@psdoloop#2,\@nil,\@nil\@@#1{#3}\fi} +\def\@psdoloop#1,#2,#3\@@#4#5{\def#4{#1}\ifx #4\@nnil \else + #5\def#4{#2}\ifx #4\@nnil \else#5\@ipsdoloop #3\@@#4{#5}\fi\fi} +\def\@ipsdoloop#1,#2\@@#3#4{\def#3{#1}\ifx #3\@nnil + \let\@nextwhile=\@psdonoop \else + #4\relax\let\@nextwhile=\@ipsdoloop\fi\@nextwhile#2\@@#3{#4}} +\def\@tpsdo#1:=#2\do#3{\xdef\@psdotmp{#2}\ifx\@psdotmp\@empty \else + \@tpsdoloop#2\@nil\@nil\@@#1{#3}\fi} +\def\@tpsdoloop#1#2\@@#3#4{\def#3{#1}\ifx #3\@nnil + \let\@nextwhile=\@psdonoop \else + #4\relax\let\@nextwhile=\@tpsdoloop\fi\@nextwhile#2\@@#3{#4}} +% +% +\def\psdraft{ + \def\@psdraft{0} + %\typeout{draft level now is \@psdraft \space . } +} +\def\psfull{ + \def\@psdraft{100} + %\typeout{draft level now is \@psdraft \space . } +} +\psfull +\newif\if@prologfile +\newif\if@postlogfile +\newif\if@noisy +\def\pssilent{ + \@noisyfalse +} +\def\psnoisy{ + \@noisytrue +} +\psnoisy +%%% These are for the option list. +%%% A specification of the form a = b maps to calling \@p@@sa{b} +\newif\if@bbllx +\newif\if@bblly +\newif\if@bburx +\newif\if@bbury +\newif\if@height +\newif\if@width +\newif\if@rheight +\newif\if@rwidth +\newif\if@clip +\newif\if@verbose +\def\@p@@sclip#1{\@cliptrue} + +%%% GDH 7/26/87 -- changed so that it first looks in the local directory, +%%% then in a specified global directory for the ps file. + +\def\@p@@sfile#1{\def\@p@sfile{null}% + \openin1=#1 + \ifeof1\closein1% + \openin1=\figurepath#1 + \ifeof1\typeout{Error, File #1 not found} + \else\closein1 + \edef\@p@sfile{\figurepath#1}% + \fi% + \else\closein1% + \def\@p@sfile{#1}% + \fi} +\def\@p@@sfigure#1{\def\@p@sfile{null}% + \openin1=#1 + \ifeof1\closein1% + \openin1=\figurepath#1 + \ifeof1\typeout{Error, File #1 not found} + \else\closein1 + \def\@p@sfile{\figurepath#1}% + \fi% + \else\closein1% + \def\@p@sfile{#1}% + \fi} + +\def\@p@@sbbllx#1{ + %\typeout{bbllx is #1} + \@bbllxtrue + \dimen100=#1 + \edef\@p@sbbllx{\number\dimen100} +} +\def\@p@@sbblly#1{ + %\typeout{bblly is #1} + \@bbllytrue + \dimen100=#1 + \edef\@p@sbblly{\number\dimen100} +} +\def\@p@@sbburx#1{ + %\typeout{bburx is #1} + \@bburxtrue + \dimen100=#1 + \edef\@p@sbburx{\number\dimen100} +} +\def\@p@@sbbury#1{ + %\typeout{bbury is #1} + \@bburytrue + \dimen100=#1 + \edef\@p@sbbury{\number\dimen100} +} +\def\@p@@sheight#1{ + \@heighttrue + \dimen100=#1 + \edef\@p@sheight{\number\dimen100} + %\typeout{Height is \@p@sheight} +} +\def\@p@@swidth#1{ + %\typeout{Width is #1} + \@widthtrue + \dimen100=#1 + \edef\@p@swidth{\number\dimen100} +} +\def\@p@@srheight#1{ + %\typeout{Reserved height is #1} + \@rheighttrue + \dimen100=#1 + \edef\@p@srheight{\number\dimen100} +} +\def\@p@@srwidth#1{ + %\typeout{Reserved width is #1} + \@rwidthtrue + \dimen100=#1 + \edef\@p@srwidth{\number\dimen100} +} +\def\@p@@ssilent#1{ + \@verbosefalse +} +\def\@p@@sprolog#1{\@prologfiletrue\def\@prologfileval{#1}} +\def\@p@@spostlog#1{\@postlogfiletrue\def\@postlogfileval{#1}} +\def\@cs@name#1{\csname #1\endcsname} +\def\@setparms#1=#2,{\@cs@name{@p@@s#1}{#2}} +% +% initialize the defaults (size the size of the figure) +% +\def\ps@init@parms{ + \@bbllxfalse \@bbllyfalse + \@bburxfalse \@bburyfalse + \@heightfalse \@widthfalse + \@rheightfalse \@rwidthfalse + \def\@p@sbbllx{}\def\@p@sbblly{} + \def\@p@sbburx{}\def\@p@sbbury{} + \def\@p@sheight{}\def\@p@swidth{} + \def\@p@srheight{}\def\@p@srwidth{} + \def\@p@sfile{} + \def\@p@scost{10} + \def\@sc{} + \@prologfilefalse + \@postlogfilefalse + \@clipfalse + \if@noisy + \@verbosetrue + \else + \@verbosefalse + \fi +} +% +% Go through the options setting things up. +% +\def\parse@ps@parms#1{ + \@psdo\@psfiga:=#1\do + {\expandafter\@setparms\@psfiga,}} +% +% Compute bb height and width +% +\newif\ifno@bb +\newif\ifnot@eof +\newread\ps@stream +\def\bb@missing{ + \if@verbose{ + \typeout{psfig: searching \@p@sfile \space for bounding box} + }\fi + \openin\ps@stream=\@p@sfile + \no@bbtrue + \not@eoftrue + \catcode`\%=12 + \loop + \read\ps@stream to \line@in + \global\toks200=\expandafter{\line@in} + \ifeof\ps@stream \not@eoffalse \fi + %\typeout{ looking at :: \the\toks200 } + \@bbtest{\toks200} + \if@bbmatch\not@eoffalse\expandafter\bb@cull\the\toks200\fi + \ifnot@eof \repeat + \catcode`\%=14 +} +\catcode`\%=12 +\newif\if@bbmatch +\def\@bbtest#1{\expandafter\@a@\the#1%%BoundingBox:\@bbtest\@a@} +\long\def\@a@#1%%BoundingBox:#2#3\@a@{\ifx\@bbtest#2\@bbmatchfalse\else\@bbmatchtrue\fi} +\long\def\bb@cull#1 #2 #3 #4 #5 { + \dimen100=#2 bp\edef\@p@sbbllx{\number\dimen100} + \dimen100=#3 bp\edef\@p@sbblly{\number\dimen100} + \dimen100=#4 bp\edef\@p@sbburx{\number\dimen100} + \dimen100=#5 bp\edef\@p@sbbury{\number\dimen100} + \no@bbfalse +} +\catcode`\%=14 +% +\def\compute@bb{ + \no@bbfalse + \if@bbllx \else \no@bbtrue \fi + \if@bblly \else \no@bbtrue \fi + \if@bburx \else \no@bbtrue \fi + \if@bbury \else \no@bbtrue \fi + \ifno@bb \bb@missing \fi + \ifno@bb \typeout{FATAL ERROR: no bb supplied or found} + \no-bb-error + \fi + % + \count203=\@p@sbburx + \count204=\@p@sbbury + \advance\count203 by -\@p@sbbllx + \advance\count204 by -\@p@sbblly + \edef\@bbw{\number\count203} + \edef\@bbh{\number\count204} + %\typeout{ bbh = \@bbh, bbw = \@bbw } +} +% +% \in@hundreds performs #1 * (#2 / #3) correct to the hundreds, +% then leaves the result in @result +% +\def\in@hundreds#1#2#3{\count240=#2 \count241=#3 + \count100=\count240 % 100 is first digit #2/#3 + \divide\count100 by \count241 + \count101=\count100 + \multiply\count101 by \count241 + \advance\count240 by -\count101 + \multiply\count240 by 10 + \count101=\count240 %101 is second digit of #2/#3 + \divide\count101 by \count241 + \count102=\count101 + \multiply\count102 by \count241 + \advance\count240 by -\count102 + \multiply\count240 by 10 + \count102=\count240 % 102 is the third digit + \divide\count102 by \count241 + \count200=#1\count205=0 + \count201=\count200 + \multiply\count201 by \count100 + \advance\count205 by \count201 + \count201=\count200 + \divide\count201 by 10 + \multiply\count201 by \count101 + \advance\count205 by \count201 + % + \count201=\count200 + \divide\count201 by 100 + \multiply\count201 by \count102 + \advance\count205 by \count201 + % + \edef\@result{\number\count205} +} +\def\compute@wfromh{ + % computing : width = height * (bbw / bbh) + \in@hundreds{\@p@sheight}{\@bbw}{\@bbh} + %\typeout{ \@p@sheight * \@bbw / \@bbh, = \@result } + \edef\@p@swidth{\@result} + %\typeout{w from h: width is \@p@swidth} +} +\def\compute@hfromw{ + % computing : height = width * (bbh / bbw) + \in@hundreds{\@p@swidth}{\@bbh}{\@bbw} + %\typeout{ \@p@swidth * \@bbh / \@bbw = \@result } + \edef\@p@sheight{\@result} + %\typeout{h from w : height is \@p@sheight} +} +\def\compute@handw{ + \if@height + \if@width + \else + \compute@wfromh + \fi + \else + \if@width + \compute@hfromw + \else + \edef\@p@sheight{\@bbh} + \edef\@p@swidth{\@bbw} + \fi + \fi +} +\def\compute@resv{ + \if@rheight \else \edef\@p@srheight{\@p@sheight} \fi + \if@rwidth \else \edef\@p@srwidth{\@p@swidth} \fi +} +% +% Compute any missing values +\def\compute@sizes{ + \compute@bb + \compute@handw + \compute@resv +} +% +% \psfig +% usage : \psfig{file=, height=, width=, bbllx=, bblly=, bburx=, bbury=, +% rheight=, rwidth=, clip=} +% +% "clip=" is a switch and takes no value, but the `=' must be present. +\def\psfig#1{\vbox { + % do a zero width hard space so that a single + % \psfig in a centering enviornment will behave nicely + %{\setbox0=\hbox{\ }\ \hskip-\wd0} + % + \ps@init@parms + \parse@ps@parms{#1} + \compute@sizes + % + \ifnum\@p@scost<\@psdraft{ + \if@verbose{ + \typeout{psfig: including \@p@sfile \space } + }\fi + % + \special{ps::[begin] \@p@swidth \space \@p@sheight \space + \@p@sbbllx \space \@p@sbblly \space + \@p@sbburx \space \@p@sbbury \space + startTexFig \space } + \if@clip{ + \if@verbose{ + \typeout{(clip)} + }\fi + \special{ps:: doclip \space } + }\fi + \if@prologfile + \special{ps: plotfile \@prologfileval \space } \fi + \special{ps: plotfile \@p@sfile \space } + \if@postlogfile + \special{ps: plotfile \@postlogfileval \space } \fi + \special{ps::[end] endTexFig \space } + % Create the vbox to reserve the space for the figure + \vbox to \@p@srheight true sp{ + \hbox to \@p@srwidth true sp{ + \hss + } + \vss + } + }\else{ + % draft figure, just reserve the space and print the + % path name. + \vbox to \@p@srheight true sp{ + \vss + \hbox to \@p@srwidth true sp{ + \hss + \if@verbose{ + \@p@sfile + }\fi + \hss + } + \vss + } + }\fi +}} +\def\psglobal{\typeout{psfig: PSGLOBAL is OBSOLETE; use psprint -m instead}} +\catcode`\@=12\relax + diff --git a/docs/release.kc.010 b/docs/release.kc.010 new file mode 100644 index 0000000..33f6660 --- /dev/null +++ b/docs/release.kc.010 @@ -0,0 +1,21 @@ +Release Message: kinetic compiler v0.10 (beta). + +Features: +- Easy-to-learn grammar + 1) Kinetics using mass-action law, power law or general expressions + 2) Constrained compounds by general expressions + 3) 'compound specific' constants +- Code generator to: + 1) CONT + 2) Auto86 + 3) Dalimil Snita's Chemical Meta Language + 4) Kin + +Documentation: + 1) Programmer's manual to kc v0.10 + 2) User's manual + +A special version to IBM PC is availaible. Please e-mail about +configuration. + +The version is a beta version because of lack of test. diff --git a/docs/release.kc.025 b/docs/release.kc.025 new file mode 100644 index 0000000..8c6c32a --- /dev/null +++ b/docs/release.kc.025 @@ -0,0 +1,38 @@ +Release note for Kinetic Compiler version 0.25. The version is +released in Semtember 1993. The packages includes code written by P.G. +Sorensen, K. Neilsen, O. Jensen (et al.) and K. Geisshirt. + +The Kinetic Compiler is a front-end to various other programs. The +main input is chemical models - a set of reactions - but ordinary +differential equations can also be used. Below the features are +summarised: + +o Models can be up to 150 reactions and each reaction can evolve up to + 150 species. +o The rate of the reactions can be one of the following three: + (i) mass action (default) + (ii) power law + (iii) user-defined rate expression +o Ordinary differential equations can be specified instead of + reactions, and ODE and chemical reaction can the mixed. +o Constraints on the concentrations can be specified. This reduces + the dimension of the concentration spaces. +o All manipulations of expression are done symbolically, even + differentiation. +o The Kinetic Compiler generates code which can - at the moment - be + used to: + (i) dynamical simulations, i.e. finding the concentrations as + function of time in a well-stirred reaction tank. + (ii) calculating various properties for the model. + (iii) continuations with one parameter. + (iv) simulations of inhomogenous reactions, i.e. diffusion-reaction + systems. +o Two manuals are written: + (i) Programmer's reference manual + (i) User's manual +o Species related constants can be written into the model. + +The program is written in ANSI-C and uses lex and yacc. The program is +easy to port to various platforms (tested on HP-UX and Linux). The +program is generating some Pascal code, but p2c can be used as +compiler for this code. \ No newline at end of file diff --git a/docs/seminar.tex b/docs/seminar.tex new file mode 100644 index 0000000..4ac5408 --- /dev/null +++ b/docs/seminar.tex @@ -0,0 +1,234 @@ +% Sidst opdateret: 25/1 1994 +\documentstyle[a4,nfdcfnt,12pt]{article} +\input{psfig} +\parindent=0cm +\pagestyle{empty} +\begin{document} +\Large +\vspace{5cm} +\begin{center} +Seminar about \\ +The Kinetic Compiler \\ + +\vspace{2cm} +Kenneth Geisshirt \\ +25 January 1994 +\end{center} + +\vspace{5cm} +\begin{itemize} +\item Chemical Kinetics. +\item Motivation. +\item The Basic Components. +\item Overall Structure of Input. +\item Reactions and Ordinary Differential Equations. +\item Simulations. +\item A Larger Example. +\end{itemize} +\newpage + +\begin{center} +Chemical Kinetics +\end{center} + +\vspace{2cm} +The chemical kinetics (in a stirred system) is modeled by + +\[ + \frac{d\vec{c}}{dt} = \vec{f}(\vec{c}), +\] + +\vspace{1cm} +and with diffusion + +\[ + \frac{\partial\vec{c}}{dt} = \vec{f}(\vec{c}) + \mathbf{D}\nabla^2 \vec{c}. +\] + +\vspace{1.5cm} +From the velocity of each reaction, one can write + +\[ + \frac{d\vec{c}}{dt} = \mathbf{\nu}\vec{v}(\vec{c}). +\] + +\newpage +\begin{center} +Motivation +\end{center} + +\vspace{1cm} +The law of mass action gives us the velocity + +\[ + v_i = k_i \prod_{j=1}^r c_j^{\nu_{ij}}. +\] + +With $r\approx 10$ and $n\approx 10$ the complexity is high, i.e.\ easy +to make an error. + +\vspace{2cm} +The real motivation is the complexity of the Jacobian + +\[ + J_{ij} = \frac{df_i}{dc_j}. +\] + +In the numerical solution, the Jacobian is needed, because of the stiffness +of the equations. + +One could use numerical differentiation + +\[ + \frac{df_i}{dc_j} \approx \frac{f_i(c_j+h)-f_i(c_j-h)}{2h}, +\] +but it gives poor results. + +For example Calahan's method: + +\begin{eqnarray*} +\vec{k}_r &=& T({\mathbf E} - Ta_1 {\mathbf J}(\vec{c}_r))^{-1}\vec{f}(\vec{c}_{r-1}) \\ +\vec{l}_r &=& T({\mathbf E} - Ta_1 {\mathbf J}(\vec{c}_r))^{-1}\vec{f}(\vec{c}_{r-1}+b_1\vec{k}_r) \\ +\vec{c}_r &=& \vec{c}_{r-1} + R_1\vec{k}_r + R_2\vec{l}_r +\end{eqnarray*} + +\newpage +\begin{center} +The Basic Components +\end{center} + +\vspace{1cm} +\begin{description} + \item[Numbers] Legal numbers are:\\ + 10 \\ + 3.14 \\ + 3.0e-6 \\ + 4.4L+10 + \item[Names] A name is a letter followed by letters and/or numbers. E.g.\ \\ + HelloWorld \\ + pi \\ + Pi \\ + Const1b + \item[Species] Legal species are: \\ + H2O \\ + so4(-2) \\ + H(+) + \item[Concentrations] are species in brackets: \\ + {\rm [}H2O{\rm ]} \\ + {\rm [}so4(-2){\rm ]} \\ + {\rm [}H(+){\rm ]} +\end{description} + +\newpage +Expressions are typed as in ordinary programming languages. In general: + +\vspace{.5cm} +expr op expr \\ +- expr \\ +( expr ) \\ +func ( expr ) + +\vspace{.5cm} +Operators (op) are +, -, *, /, **, and functions (func) can be +the standard functions. + +\vspace{.5cm} +Legal expressions are: + +2+x;\\ +4-(x**1.5)-(x+y)/2;\\ +3+exp(x)*sin(t); + +\newpage +\begin{center} +General Structure of an Input File +\end{center} + +\psfig{file=struct.ps,width=14cm,height=15cm} + +\vspace{2cm} +Declaration of constants:\\ +time = 2.50; + +\newpage +\begin{center} +Reactions and Ordinary Differential equations +\end{center} + +A reaction is written in the form: + +number: coeff spec + $\cdots$ -> coeff spec + $\cdots$; k>=expr; + +\vspace{.5cm} +Examples of legal reactions: + +20: A + 2B -> C; k>=2.0;\\ +42: A(+) + B <-> 2B; k>=2.0; k<=4.1;\\ +45: A -> B + C; v>=[A]/(1+2*[B]*[C]\ $\hat{}$\ 3);\\ +63: B <-> A; v>=[A]/[B]\ $\hat{}$\ 2; k<=2.12; + +\vspace{3cm} +Ordinary differential equations can be used as well. + +They are written in the form: + +\vspace{.25cm} +name' = expr; + +\vspace{.5cm} +Legal differential equations are: + +x' = x;\\ +temp' = sin(t)*exp(temp-2*kb*[A]); + +\newpage +\begin{center} +Constraints and Initial Values +\end{center} + +\vspace{1cm} +In chemical kinetics one often has constraints in the form + +\[ + \sum_{i} [S_i] = C. +\] + +If one rewrites them to + +\[ + [S_{i\prime}] = C - \sum_{i\not =i\prime} [S_i], +\] + +{\tt kc} is able to use them. For example: + +\[ + [{\mathrm Ce^{4+}}] + [{\mathrm Ce^{3+}}] = C_{\mathrm tot} +\] + +is written as \\ +{\rm [}Ce($+4$){\rm ]} = Ctot - {\rm [}Ce($+3$){\rm ]}; + +Actually, the right hand side can be any expression. + +\vspace{2cm} +Concentrations and dynamical values can be assigned a value +at $t=0$. For example:\\ + +[A](0) = 1.2e-10;\\ +temp(0) = 273.15; + +\newpage +\begin{center} +Making Simulations +\end{center} + +\vspace{1cm} +To simulate a CSTR one has to go through two steps. + +\begin{itemize} +\item Write a input file; +\item Run the simulation program: {\tt kkin file-name}. +\end{itemize} + +The output file is {\tt kinwrk.dat} and is in GNUplot format. +\end{document} diff --git a/docs/stream.fig b/docs/stream.fig new file mode 100644 index 0000000..66cc8b0 --- /dev/null +++ b/docs/stream.fig @@ -0,0 +1,39 @@ +#FIG 2.1 +80 2 +2 4 0 1 -1 0 0 0 0.000 7 0 0 + 279 199 279 79 79 79 79 199 279 199 9999 9999 +2 4 0 1 -1 0 0 0 0.000 7 0 0 + 599 199 599 79 399 79 399 199 599 199 9999 9999 +2 4 0 1 -1 0 0 0 0.000 7 0 0 + 319 399 319 279 159 279 159 399 319 399 9999 9999 +2 4 0 1 -1 0 0 0 0.000 7 0 0 + 519 399 519 279 359 279 359 399 519 399 9999 9999 +2 1 0 1 -1 0 0 0 0.000 -1 1 0 + 0 0 1.000 4.000 8.000 + 19 139 79 139 9999 9999 +2 1 0 1 -1 0 0 0 0.000 -1 1 0 + 0 0 1.000 4.000 8.000 + 279 139 399 139 9999 9999 +2 1 0 1 -1 0 0 0 0.000 -1 1 0 + 0 0 1.000 4.000 8.000 + 599 139 659 139 9999 9999 +2 4 0 1 -1 0 0 0 0.000 7 0 0 + 559 439 559 239 119 239 119 439 559 439 9999 9999 +2 1 0 1 -1 0 0 0 0.000 -1 1 1 + 0 0 1.000 4.000 8.000 + 0 0 1.000 4.000 8.000 + 179 199 239 239 9999 9999 +2 1 0 1 -1 0 0 0 0.000 -1 0 0 + 499 199 9999 9999 +2 1 0 1 -1 0 0 0 0.000 -1 1 1 + 0 0 1.000 4.000 8.000 + 0 0 1.000 4.000 8.000 + 499 199 439 239 9999 9999 +4 0 0 12 0 -1 0 0.00000 4 12 124 384 339 Expression manipulation +4 0 0 12 0 -1 0 0.00000 4 12 65 199 339 Symbol table +4 0 0 12 0 -1 0 0.00000 4 12 44 19 134 Input file +4 0 0 12 0 -1 0 0.00000 4 12 53 609 134 Output file +4 0 0 12 0 -1 0 0.00000 4 12 77 444 139 Code generator +4 0 0 12 0 -1 0 0.00000 4 9 33 119 157 Parser +4 0 0 12 0 -1 0 0.00000 4 12 103 119 139 Lexical analyser and +4 0 0 12 0 -1 0 0.00000 4 9 70 299 134 Processed file diff --git a/docs/stream.ps b/docs/stream.ps new file mode 100644 index 0000000..735922d Binary files /dev/null and b/docs/stream.ps differ diff --git a/docs/struct.fig b/docs/struct.fig new file mode 100644 index 0000000..9e0d7a3 --- /dev/null +++ b/docs/struct.fig @@ -0,0 +1,13 @@ +#FIG 2.1 +80 2 +2 2 0 1 -1 0 0 0 0.000 0 0 0 + 399 599 399 39 39 39 39 599 399 599 9999 9999 +2 4 0 1 -1 0 0 0 0.000 7 0 0 + 359 224 359 79 79 79 79 224 359 224 9999 9999 +2 4 0 1 -1 0 0 0 0.000 7 0 0 + 359 419 359 254 79 254 79 419 359 419 9999 9999 +2 4 0 1 -1 0 0 0 0.000 7 0 0 + 359 579 359 439 79 439 79 579 359 579 9999 9999 +4 0 -1 18 0 -1 0 0.000 4 13 144 149 159 Declaration of Constants +4 0 -1 18 0 -1 0 0.000 4 13 138 159 334 Reactions and Equations +4 0 0 18 0 -1 0 0.000 4 13 180 129 519 Constraints and Initial Values diff --git a/docs/struct.ps b/docs/struct.ps new file mode 100644 index 0000000..1eaa1bb Binary files /dev/null and b/docs/struct.ps differ diff --git a/kc-inst b/kc-inst new file mode 100755 index 0000000..28b8a8a --- /dev/null +++ b/kc-inst @@ -0,0 +1,100 @@ +#!/bin/sh + +########################################################################### +# Installation script for the Kinetic Compiler. # +# # +# Copyright 1994-1995 by Kenneth Geisshirt and Keld Nielsen # +# # +# Please see README.md for further information, and LICENSE for # +# legal matters. # +########################################################################### + +VERSION="1.10" + +case $# in +0) + echo "Installation script for Kinetic Compiler version $VERSION" + echo "Copyright 1994-1995 by Kenneth Geisshirt and Keld Nielsen" + echo "The correct usage is:" + echo " kc-inst prefix platform" + echo "where prefix is a directory and platform is one of the following:" + echo " o LINUX (Linux with gcc)" + echo " o GCC (generic GCC)" + echo " o HPUX (old HP-UX systems, version<=7)" + echo " o ULTRIX (Digital computers)" + echo " o CONVEX (Convex)" + echo " o SGI (Silicon Graphics)" + echo " o AIX (IBM)" + echo "" + echo "Remember that you should have write-access to the" + echo "directories that you specify." + exit 1;; +2) + case $2 in + LINUX) CC="gcc" + CFLAGS="-O2 -m486 -D_PLATFORM_LINUX_" + CLIBS="-lm" + MAKEFILE="Makefile.LINUX";; + GC) CC="gcc" + CFLAGS="-O2 -m486 -D_PLATFORM_GCC_ -D_USE_GARBAGE_COL_" + CLIBS="-lm" + MAKEFILE="Makefile.GC";; + GCC) CC="gcc" + CFLAGS="-O2 -D_PLATFORM_GCC_" + CLIBS="-ll -lm" + MAKEFILE="Makefile.GCC";; + HPUX) CC="cc" + CFLAGS="-Aa -O -D_PLATFORM_HPUX_" + CLIBS="-lm" + MAKEFILE="Makefile.HPUX";; + ULTRIX) CC="cc" + CFLAGS="-O2 -w -Olimit 1000 -D_PLATFORM_ULTRIX_" + CLIBS="-lm" + MAKEFILE="Makefile.ULTRI";; + CONVEX) CC="cc" + CFLAGS="-O -I/usr/include/sys -I. -w -D_PLATFORM_CONVEX_" + CLIBS="-lm" + MAKEFILE="Makefile.CVX";; + SGI) CC="cc" + CFLAGS="-ansi -w -O -D_PLATFORM_SGI_" + CLIBS="-lm" + MAKEFILE="Makefile.SGI";; + AIX) CC="xlc" + CFLAGS="-O3" + CLIBS="-lm" + MAKEFILE="Makefile.AIX";; + esac + + echo "Installation of the Kinetic Compiler System v$VERSION." + echo "Copyright by Kenneth Geisshirt and Keld Nielsen, 1992-1995." + echo + echo "Making the Kinetic Compiler." + cd src + cp $MAKEFILE Makefile + make -s PREFIX=$1 + cd .. + + echo "Preparing the numerical routines." + cd Solvers + cp $MAKEFILE Makefile + make -s PREFIX=$1 + cd .. + + echo "Making the scripts." + echo "cp $1/num/kksolver.c ." > kci + echo "cp $1/num/matrix.o ." >> kci + echo "cp $1/num/odesolv.o ." >> kci + echo "cp $1/num/odeserv.o ." >> kci + echo "$1/bin/kc -m3 -v < \$1" >> kci + echo "$CC $CFLAGS -c -I. -I$1/num -I- kksolver.c" >> kci + echo "$CC $CFLAGS matrix.o kksolver.o odesolv.o odeserv.o $CLIBS" >> kci + echo "rm -f model.c model.h kksolver.c kksolver.o matrix.o odesolv.o odeserv.o" >> kci + echo "a.out" >> kci + echo "rm -f a.out" >> kci + chmod 777 kci + mv kci $1/bin + +esac + + + diff --git a/old_src/autocode.c b/old_src/autocode.c new file mode 100644 index 0000000..42b2801 --- /dev/null +++ b/old_src/autocode.c @@ -0,0 +1,279 @@ +/* SymbCont - a code generator for kc and Auto86. + CopyWrong by Kenneth Geisshirt, 1992, 1993 + + See kc.tex for details +*/ + +#include +#include +#include +#include "config.h" +#include "symbmath.h" +#include "tableman.h" + +void AutoCode(FILE *code) { + + double charge, temp, coeff; + char *name, *rename; + time_t timer; + struct Tree *v[ExprSize+SymSize], *con[ConstrainSize], *r[ExprSize+SymSize]; + struct Tree *jacobi[ExprSize+SymSize][ExprSize+SymSize]; + struct Tree *v_temp, *tmp, *tmp2; + int i, j, k, react_no, finished, constraint, dyn, dyn2; + + name=malloc(sizeof(char)); + rename=malloc(sizeof(char)); + timer=time(&timer); + + /* process constraints */ + for(i=1; i<=NumOfConstraint(); i++) { + tmp=TreeCreate(); + con[i-1]=TreeCreate(); + tmp=GetConstraintNo(i, name, &charge); + if (GetError()==NotFound) + fprintf(stderr, "Constraint number %d does not exist.\n", i); + else { + RenameSpec(rename, name, charge); + for(j=1; j0) { + fprintf(code, " %s=", rename); + TreePrint(con[constraint-1], 1, code); + fprintf(code, "\n"); + }; /* if */ + }; /* for i */ + for(i=1; i<=NoOfReact(); i++) { + r[i-1]=TreeCreate(); + react_no=GetReactNo(i-1); + switch (GetReactKind(react_no)) { + case uni: if (GetRateKind(react_no, uni, 1)==1) { + r[i-1]=TreeAssignConst(r[i-1], GetRateConst(react_no, uni, 1)); + finished=GetFirstSpecA(react_no, name, &charge, &coeff); + while (finished==1) { + if (coeff>0.0) { + RenameSpec(rename, name, charge); + temp=GetPowConstInReact(react_no, name, charge); + tmp=TreeCreate(); + constraint=IsSpecInConstraint(name, charge); + if (constraint>0) + tmp=GetConstraintNo(constraint, name, &charge); + else + tmp=TreeAssignVar(tmp, rename); + tmp=TreePow(tmp, temp); + r[i-1]=TreeMul(r[i-1], tmp); + TreeKill(tmp); + }; /* if */ + finished=GetNextSpecA(name, &charge, &coeff); + }; /* while */ + } /* if */ + else + r[i-1]=GetRateExpr(react_no, uni, 1); + fprintf(code, " r%d=", i-1); + TreePrint(r[i-1], 1, code); + fprintf(code, "\n"); + break; + case bi: if (GetRateKind(react_no, bi, 1)==1) { + r[i-1]=TreeAssignConst(r[i-1], GetRateConst(react_no, bi, 1)); + finished=GetFirstSpecA(react_no, name, &charge, &coeff); + while (finished==1) { + if (coeff>0.0) { + RenameSpec(rename, name, charge); + temp=GetPowConstInReact(react_no, name, charge); + tmp=TreeCreate(); + constraint=IsSpecInConstraint(name, charge); + if (constraint>0) + tmp=GetConstraintNo(constraint, name, &charge); + else + tmp=TreeAssignVar(tmp, rename); + tmp=TreePow(tmp, temp); + r[i-1]=TreeMul(r[i-1], tmp); + TreeKill(tmp); + }; /* if */ + finished=GetNextSpecA(name, &charge, &coeff); + }; /* while */ + } /* if */ + else + r[i-1]=GetRateExpr(react_no, bi, 1); + v_temp=TreeCreate(); + if (GetRateKind(react_no, bi, 2)==1) { + v_temp=TreeAssignConst(v_temp, GetRateConst(react_no, bi, 2)); + finished=GetFirstSpecA(react_no, name, &charge, &coeff); + while (finished==1) { + if (coeff<0.0) { + RenameSpec(rename, name, charge); + temp=GetPowConstInReact(react_no, name, charge); + tmp=TreeCreate(); + constraint=IsSpecInConstraint(name, charge); + if (constraint>0) + tmp=GetConstraintNo(constraint, name, &charge); + else + tmp=TreeAssignVar(tmp, rename); + tmp=TreePow(tmp, temp); + r[i-1]=TreeMul(r[i-1], tmp); + TreeKill(tmp); + }; /* if */ + finished=GetNextSpecA(name, &charge, &coeff); + }; /* while */ + } /* if */ + else + v_temp=GetRateExpr(react_no, bi, 2); + r[i-1]=TreeSub(r[i-1], v_temp); + TreeKill(v_temp); + fprintf(code, " r%d=", i-1); + TreePrint(r[i-1], 1, code); + fprintf(code, "\n"); + break; + case equi: fprintf(stderr, "Please use the construction: [J] = expr instead of equilibriums.\n"); + break; + }; /* switch */ + }; /* for i */ + dyn=0; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) { + v[dyn]=TreeCreate(); + for(j=1; j<=NoOfReact(); j++) { + if (IsSpecInReact(GetReactNo(j-1), name, charge, &coeff)==1) { + if (j==1) { + fprintf(code, " f(%d)=", dyn); + tmp=TreeCreate(); + tmp=TreeAssignConst(tmp, 0); + }; /* if */ + v_temp=TreeCreate(); + v_temp=TreeAssignConst(v_temp, coeff); + v_temp=TreeMul(v_temp, TreeCpy(r[j-1])); + tmp=TreeAdd(tmp, v_temp); + TreeKill(v_temp); + }; /* if */ + if (j==NoOfReact()) { + TreePrint(tmp, 1, code); + fprintf(code, "\n"); + v[dyn]=TreeCpy(tmp); + TreeKill(tmp); + }; /* if */ + }; /* for j */ + dyn++; + }; /* if */ + }; /* for i */ + for(i=1; i<=NumOfExpr(); i++) { + tmp=TreeCreate(); + tmp=GetExprNo(i, name); + v[dyn]=TreeCpy(tmp); + fprintf(code, " f(%d)=", dyn+1); + TreePrint(tmp, 1, code); + fprintf(code, "\n"); + dyn++; + }; /* for i */ + fprintf(code, " IF (ijac.EQ.0) RETURN\n"); + for(i=1; i<=NoOfReact(); i++) { + dyn=1; + for(j=1; j<=NoOfSpec(); j++) { + jacobi[i-1][dyn-1]=TreeCreate(); + tmp=TreeCreate(); + tmp=TreeCpy(v[dyn-1]); + GetSpecNo(j, name, &charge); + RenameSpec(rename, name, charge); + if (IsSpecInConstraint(name, charge)==0) { + tmp=TreeDerive(tmp, rename); + fprintf(code, " dfdu(%d, %d)=", i, dyn); + TreePrint(tmp, 1, code); + fprintf(code, "\n"); + jacobi[i-1][dyn-1]=TreeCpy(tmp); + dyn++; + }; /* if */ + TreeKill(tmp); + }; /* for j */ + dyn2=1; + for(j=1; j<=NumOfDynVar(); j++) { + jacobi[i-1][j-1+NoOfSpec()-NumOfConstraint()]=TreeCreate(); + tmp=TreeCreate(); + tmp=TreeCpy(v[dyn-1]); + GetDynVarNo(j, name); + if (IsVarParameter(name)==0) { + tmp=TreeDerive(tmp, name); + fprintf(code, " dfdp(%d, %d)=", i, dyn2); + TreePrint(tmp, 1, code); + fprintf(code, "\n"); + jacobi[i-1][dyn2-1+NoOfSpec()-NumOfConstraint()]=TreeCpy(tmp); + dyn2++; + }; /* if */ + TreeKill(tmp); + }; /* for j */ + }; /* for i */ + for(i=1; i<=NumOfExpr(); i++) { + dyn2=1; + for(j=1; j<=NumOfExpr(); j++) { + /* JACOBI is missing!!! */ + tmp=TreeCreate(); + tmp=TreeCpy(v[dyn-1]); + tmp2=TreeCreate(); + tmp2=GetExprNo(j, name); + if (IsVarParameter(name)!=0) { + tmp=TreeDerive(tmp, name); + fprintf(code, " dfdx(%d, %d)=", i, dyn2); + TreePrint(tmp, 1, code); + fprintf(code, "\n"); + dyn2++; + }; /* if */ + TreeKill(tmp); + TreeKill(tmp2); + }; /* for j */ + dyn2=1; + for(j=1; j<=NumOfDynVar(); j++) { + jacobi[dyn+i-1][dyn2+j-1+NoOfSpec()-NumOfConstraint()]=TreeCreate(); + tmp=TreeCreate(); + tmp=TreeCpy(v[dyn-1]); + GetDynVarNo(j, name); + if (IsVarParameter(name)==0) { + tmp=TreeDerive(tmp, name); + fprintf(code, " dfdp(%d, %d)=", i, dyn2); + TreePrint(tmp, 1, code); + fprintf(code, "\n"); + jacobi[dyn+i-1][dyn2-1+NoOfSpec()-NumOfConstraint()]=TreeCpy(tmp); + dyn2++; + }; /* if */ + TreeKill(tmp); + }; /* for j */ + }; /* for i */ + fprintf(code, " RETURN\n END\n"); +} /* AutoCode */ + diff --git a/old_src/autocode.h b/old_src/autocode.h new file mode 100644 index 0000000..29df64e --- /dev/null +++ b/old_src/autocode.h @@ -0,0 +1,7 @@ +/* Code generator AutoCode + CopyWrong by Kenneth Geisshirt, 1993 + + See kc.tex for details. +*/ + +extern void AutoCode(FILE *); diff --git a/old_src/autocont.c b/old_src/autocont.c new file mode 100644 index 0000000..43c3c63 --- /dev/null +++ b/old_src/autocont.c @@ -0,0 +1,122 @@ +/* AutoCont - a code generator for kc and CONT using + power law and mass-action law. + CopyWrong by Kenneth Geisshirt, 1992 + + See kc.tex for details. + Version 0.00 + + Only for experimental use!!! +*/ + +#include +#include +#include +#include + +static int line_len; + +void LineBreaker(FILE *out) { + + if (line_len>=60) { + fprintf(out, "\n &"); + line_len=0; + }; +} /* LineBreaker */ + +void AutoCont(FILE *code) { + + int i, j; /* counters */ + int in_use[ReactSize]; /* any right to left reactions? */ + char *name, *rename; /* formal and actual names */ + double charge, coeff, value; /* misc. values */ + int react_no; /* reaction number (source) */ + int finished; /* boolean stop variable */ + int line_len; /* #chars written on line */ + time_t timer; + + name=malloc(sizeof(char)); + rename=malloc(sizeof(char)); + timer=time(&timer); + +/* The actual code generator */ + + fprintf(code, " SUBROUTINE MODEL(NDIM,NVAR,N,T,X,F,G)\n"); + fprintf(code, "C *********************************************\n"); + fprintf(code, "C %s", ctime(&timer)); + fprintf(code, "C *********************************************\n"); + fprintf(code, " IMPLICIT REAL *8(A-H,O-Z)\n"); + for(i=0; i<=NoOfSpec()-1; i++) { + GetSpecNo(i+1, name, &charge); + RenameSpec(rename, name, charge); + fprintf(code, " REAL %s\n", rename); + }; /* for */ + fprintf(code, "   DIMENSION X(NDIM),F(NDIM),G(NDIM,NVAR)\n"); + fprintf(code, " COMMON/FIXP/PAR(20)\n"); + fprintf(code, " COMMON/VARP/ALPHA,BETA,ARG,PER\n"); + fprintf(code, "\nC Make aliases\n"); + for(i=0; i<=NoOfSpec()-1; i++) { + GetSpecNo(i+1, name, &charge); + RenameSpec(rename, name, charge); + fprintf(code, " %s = X(%d)\n", rename, i); + }; /* for */ + for(i=1; i<=NoOfReact(); i++) { + fprintf(code, "C Rate of reaction no. "); + react_no=GetReactNo(i-1); /* not pretty, but needed */ + fprintf(code, "%d\n", react_no); + switch (GetReactKind(react_no)) { + case uni : line_len=20; + fprintf(code, " F(%d) = ", i-1); + fprintf(code, "%e", GetRateConst(react_no, uni, 1)); + finished=GetFirstSpecA(react_no, name, &charge, &coeff); + while (finished==1) { + if (coeff>0.0) { + RenameSpec(rename, name, charge); + LineBreaker(code); + fprintf(code, "*(%s**%e)", rename, coeff); + line_len=line_len+strlen(rename)+13; + }; /* if */ + finished=GetNextSpecA(name, &charge, &coeff); + }; /* while */ + fprintf(code, "\n"); + break; + case bi : /* Left to right reaction */ + line_len=20; + fprintf(code, " F(%d) = ", i-1); + fprintf(code, "%e", GetRateConst(react_no, bi, 1)); + finished=GetFirstSpecA(react_no, name, &charge, &coeff); + while (finished==1) { + if (coeff>0.0) { + RenameSpec(rename, name, charge); + LineBreaker(code); + fprintf(code, "*(%s**%e)", rename, coeff); + line_len=line_len+strlen(rename)+13; + }; /* if */ + finished=GetNextSpecA(name, &charge, &coeff); + }; /* while */ + /* Right to left reaction */ + fprintf(code, "-%e", GetRateConst(react_no, bi, 2)); + line_len=line_len+10; + finished=GetFirstSpecA(react_no, name, &charge, &coeff); + while (finished==1) { + if (coeff<0.0) { + RenameSpec(rename, name, charge); + LineBreaker(code); + fprintf(code, "*(%s**%e)", rename, -coeff); + line_len=line_len+strlen(rename)+13; + }; /* if */ + finished=GetNextSpecA(name, &charge, &coeff); + }; /* while */ + fprintf(code, "\n"); + break; + case equi : /* not implemented */ + fprintf(stderr, "Warning: Equilibriums are not implemented as feature - yet\n"); + break; + }; /* switch */ + }; /* for */ + fprintf(code, "C *******************************************\n"); + fprintf(code, " IF (N.EQ.NDIM) RETURN\n"); + fprintf(code, "C *******************************************\n"); + fprintf(code, "C Jacobian:\n"); + fprintf(code, " RETURN\n"); + fprintf(code, " END\n"); +} /* AutoCont */ diff --git a/old_src/charmode.c b/old_src/charmode.c new file mode 100644 index 0000000..c0168f1 --- /dev/null +++ b/old_src/charmode.c @@ -0,0 +1,299 @@ +/************************************************************************** + CharMode - a code generator for kc and the CharMode + package. + + CopyWrong 1993-1994 by + Kenneth Gesshirt (kneth@osc.kiku.dk) + Department of Theoretical Chemistry + H.C. Orsted Institute + Universitetsparken 5 + 2100 Copenhagen + Denmark + + See kc.tex for details. + Last updated: 12 May 1995 by KN +***************************************************************************/ + +#include +#include +#include +#include +#include "config.h" +#include "symbmath.h" +#include "tableman.h" +#include "codegen.h" +#include "misc.h" + +void CharMode(FILE* ccode, FILE *hcode) { + + double charge, temp, coeff; + char *name, *rename, *strtmp; + time_t timer; + Tree v_temp, tmp, temp_tree, tree_temp; + int i, j, NumbOfDynVars, react_no, finished, constraint, dyn, dyn2; + + name=StringAlloc(); + rename=StringAlloc(); + + NumbOfDynVars= NoOfSpec()+NumOfDynVar()-NumOfConstraint(); + + InitCodeGenVar(NumbOfDynVars, NumOfConstraint(), NoOfReact()); + GenerateRateExpr(); + GenerateJacobi(); + GenerateDiffReac(); + + timer=time(&timer); + fprintf(hcode, "/*********************************************\n"); + fprintf(hcode, " WARNING: This file was generated by kc v%s\n", VERSION); + fprintf(hcode, " CopyWrong by Kenneth Geisshirt\n"); + fprintf(hcode, " %s", ctime(&timer)); + fprintf(hcode, "**********************************************/\n"); + fprintf(hcode, "#ifndef _MODEL_HEADER_\n#define _MODEL_HEADER_\n"); + fprintf(hcode, "#define novar_ %d\n", NumbOfDynVars); + fprintf(hcode, "#define noreac_ %d\n", NoOfReact()); + fprintf(hcode, "double x_[novar_];\n"); + fprintf(hcode, "int do_print[novar_];\n"); + fprintf(hcode, "char species[25][novar_];\n"); + fprintf(hcode, "double rfw_[noreac_];\n"); + fprintf(hcode, "double rrv_[noreac_];\n"); + fprintf(hcode, "double v_[novar_];\n"); + fprintf(hcode, "double rfwds_[noreac_][novar_];\n"); + fprintf(hcode, "double rrvds_[noreac_][novar_];\n"); + fprintf(hcode, "double jacobi_matx[novar_][novar_];\n"); + fprintf(hcode, "extern void ReacRate(double *);\n"); + fprintf(hcode, "extern void ReacFlow(double *);\n"); + fprintf(hcode, "extern void Jacobi(double *);\n"); + fprintf(hcode, "extern void ReacFlow_ds(double *);\n"); + fprintf(hcode, "extern void InitValues(void);\n"); + fprintf(hcode, "#endif\n"); + + + + fprintf(ccode, "/*********************************************\n"); + fprintf(ccode, " WARNING: This file was generated by kc v%s\n", VERSION); + fprintf(ccode, " CopyWrong by Kenneth Geisshirt\n"); + fprintf(ccode, " %s", ctime(&timer)); + fprintf(ccode, "**********************************************/\n"); + fprintf(ccode, "#include \"model.h\"\n"); + fprintf(ccode, "#include \n\n"); + + /* Printing ReacRate */ + + fprintf(ccode, "void ReacRate(double* S_) {\n"); + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) { + RenameSpec(rename, name, charge); + fprintf(ccode, "double %s;\n", rename); + } /* if */ + } /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(ccode, "double %s;\n", name); + } /* for i */ + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) { + RenameSpec(rename, name, charge); + fprintf(ccode, "%s=S_[%d];\n", rename, dyn-1); + dyn++; + } /* if */ + } /* for i*/ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(ccode, "%s=S_[%d];\n", name, i+NoOfSpec()-NumOfConstraint()-1); + } /* for i */ + dyn=0; + for(i=1; i<=(NoOfSpec()+NumOfDynVar()-NumOfConstraint()); i++) { + fprintf(ccode, "v_[%d]=(", i-1); + TreePrint(v[i-1], 3, ccode); + fprintf(ccode, ");\n"); + } /* for i */ + fprintf(ccode, "} /* ReacRate */\n\n"); + + /* End of printing ReacRate */ + + /* Printing Jacobi matrix routine */ + + fprintf(ccode, "void Jacobi(double *S_){\n"); + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) { + RenameSpec(rename, name, charge); + fprintf(ccode, "double %s;\n", rename); + } /* if */ + } /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(ccode, "double %s;\n", name); + } /* for i */ + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) { + RenameSpec(rename, name, charge); + fprintf(ccode, "%s=S_[%d];\n", rename, dyn-1); + dyn++; + } /* if */ + } /* for i*/ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(ccode, "%s=S_[%d];\n", name, i+NoOfSpec()-NumOfConstraint()-1); + } /* for i */ + + for(i=0; i +#include +#include "quench.h" + +#define novar_ 4 +#define noreac_ 11 +double x_[novar_],v_[novar_]; +double jacobi_matx[novar_][novar_]; +int ref; +char species[25][novar_]; +double rfw_[noreac_]; +double rrv_[noreac_]; +double rfwds_[noreac_][novar_]; +double rrvds_[noreac_][novar_]; + +void ReacRate(double *S_) { +double HBrO2; +double Brm; +double Ce4p; +double HBrO; +HBrO2=S_[0]; +Brm=S_[1]; +Ce4p=S_[2]; +HBrO=S_[3]; +v_[0]=((((((-1.000000e+00*(4.709600e-05*HBrO2))+((2.400000e-02 +*Brm)*4.900000e-01))+(-1.000000e+00*(((3.000000e+06* +HBrO2)*Brm)*7.000000e-01)))+((5.040000e-01*HBrO2)*7.000000e-01 +))+(-2.000000e+00*(3.000000e+03*(HBrO2*HBrO2))))); + +v_[1]=((((((-1.000000e+00*(4.709600e-05*Brm))+(-1.000000e+00 +*((2.400000e-02*Brm)*4.900000e-01)))+(-1.000000e+00* +(((3.000000e+06*HBrO2)*Brm)*7.000000e-01)))+(2.500000e-01 +*(1.040000e-01*Ce4p)))+(8.000000e-02*HBrO))); + +v_[2]=((((-1.000000e+00*(4.709600e-05*Ce4p))+(2.000000e+00 +*((5.040000e-01*HBrO2)*7.000000e-01)))+(-1.000000e+00 +*(1.040000e-01*Ce4p)))); +v_[3]=(((((((-1.000000e+00*(4.709600e-05*HBrO))+((2.400000e-02 +*Brm)*4.900000e-01))+(2.000000e+00*(((3.000000e+06* +HBrO2)*Brm)*7.000000e-01)))+(3.000000e+03*(HBrO2*HBrO2 +)))+(-1.000000e+00*(8.000000e-02*HBrO)))+(-1.000000e+00 +*(1.400000e-01*HBrO)))); +} + +void jacobi(double *S_){ +double HBrO2; +double Brm; +double Ce4p; +double HBrO; +HBrO2=S_[0]; +Brm=S_[1]; +Ce4p=S_[2]; +HBrO=S_[3]; +jacobi_matx[0][0]=(((-4.709600e-05+(-1.000000e+00*((3.000000e+06 +*Brm)*7.000000e-01)))+3.528000e-01)+(-2.000000e+00*( +3.000000e+03*(HBrO2*2.000000e+00)))); +jacobi_matx[0][1]=(1.176000e-02+(-1.000000e+00*((3.000000e+06 +*HBrO2)*7.000000e-01))); +jacobi_matx[1][0]=(-1.000000e+00*((3.000000e+06*Brm)*7.000000e-01 +)); +jacobi_matx[1][1]=(-1.180710e-02+(-1.000000e+00*((3.000000e+06 +*HBrO2)*7.000000e-01))); +jacobi_matx[3][0]=((2.000000e+00*((3.000000e+06*Brm)*7.000000e-01 +))+(3.000000e+03*(HBrO2*2.000000e+00))); +jacobi_matx[3][1]=(1.176000e-02+(2.000000e+00*((3.000000e+06 +*HBrO2)*7.000000e-01))); +} + +void InitValues(void) { +x_[0]=2.810000e-08; +x_[1]=2.096800e-07; +x_[2]=1.905800e-07; +x_[3]=1.236900e-07; +(void) strcpy(species[0], "HBrO2"); +(void) strcpy(species[1], "Brm"); +(void) strcpy(species[2], "Ce4p"); +(void) strcpy(species[3], "HBrO"); + +ref= 3; + +jacobi_matx[0][2]=0.000000e+00; +jacobi_matx[0][3]=0.000000e+00; +jacobi_matx[1][2]=2.600000e-02; +jacobi_matx[1][3]=8.000000e-02; +jacobi_matx[2][0]=7.056000e-01; +jacobi_matx[2][1]=0.000000e+00; +jacobi_matx[2][2]=-1.040471e-01; +jacobi_matx[2][3]=0.000000e+00; +jacobi_matx[3][2]=0.000000e+00; +jacobi_matx[3][3]=-2.200471e-01; +} + + +void ReacFlow(double *S_) { +double HBrO2; +double Brm; +double Ce4p; +double HBrO; +HBrO2=S_[0]; +Brm=S_[1]; +Ce4p=S_[2]; +HBrO=S_[3]; + +rfw_[0]= 4.709600e-05*HBrO2; rrv_[0]= 0.0; +rfw_[1]= 4.709600e-05*Brm; rrv_[1]= 0.0; +rfw_[2]= 4.709600e-05*Ce4p; rrv_[2]= 0.0; +rfw_[3]= 4.709600e-05*HBrO; rrv_[3]= 0.0; + +rfw_[4]= 2.400000e-02*Brm*4.900000e-01; rrv_[4]= 0.0; +rfw_[5]= 3.000000e+06*HBrO2*Brm*7.000000e-01; rrv_[5]= 0.0; +rfw_[6]= 5.040000e-01*HBrO2*7.000000e-01; rrv_[6]= 0.0; +rfw_[7]= 3.000000e+03*HBrO2*HBrO2; rrv_[7]= 0.0; +rfw_[8]= 1.040000e-01*Ce4p; rrv_[8]= 0.0; +rfw_[9]= 8.000000e-02*HBrO; rrv_[9]= 0.0; +rfw_[10]=1.400000e-01*HBrO; rrv_[10]=0.0; +} + +void ReacFlowdS(double *S_) { +int i,j; +double HBrO2; +double Brm; +double Ce4p; +double HBrO; +HBrO2=S_[0]; +Brm=S_[1]; +Ce4p=S_[2]; +HBrO=S_[3]; + +for(i=0;i +#include + +#include "config.h" +#include "symbmath.h" +#include "tableman.h" + +void Pananakis(FILE *code) { + + char *name, *rename; + int i, j, l, react_no; + double temp, charge, coeff; + Tree temp_tree; + + name=(char *)malloc(sizeof(char)); + rename=(char *)malloc(sizeof(char)); + + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + fprintf(code, "REACTION(SET=%d,TERMS=%d)\n", i, NoSpecInReacs(name, charge)); + for(j=1; j<=NoOfReact(); j++) { + react_no=GetReactNo(j-1); + GetSpecNo(i, name, &charge); + if (IsSpecInReact(react_no, name, charge, &coeff)==1) { + switch (GetReactKind(react_no)) { + case uni: + temp_tree=TreeCreate(); + GetRateConst(react_no, uni, 1, temp_tree); + temp=TreeEval(temp_tree); + if (TreeGetError()==NoEval) + fprintf(stderr, "Unable to compute rate constant in reaction %d.\n", react_no); + TreeKill(temp_tree); + fprintf(code, "%e", -coeff*temp); + for(l=1; l<=NoOfSpec(); l++) { + GetSpecNo(l, name, &charge); + if (IsSpecInReact(react_no, name, charge, &coeff)==1) { + if (coeff>0.0) + fprintf(code, ",%e", coeff); + else + fprintf(code, ",0"); + } else + fprintf(code, ",0"); + } /* for l */ + break; + case bi: + temp_tree=TreeCreate(); + GetRateConst(react_no, bi, 1, temp_tree); + temp=TreeEval(temp_tree); + if (TreeGetError()==NoEval) + fprintf(stderr, "Unable to compute rate constant (>) in reaction %d.\n", react_no); + TreeKill(temp_tree); + fprintf(code, "%e", -coeff*temp); + for(l=1; l<=NoOfSpec(); l++) { + GetSpecNo(l, name, &charge); + if (IsSpecInReact(react_no, name, charge, &coeff)==1) { + if (coeff>0.0) + fprintf(code, ",%e", coeff); + else + fprintf(code, ",0"); + } else + fprintf(code, ",0"); + } /* for l */ + fprintf(code, "\n"); + temp_tree=TreeCreate(); + GetRateConst(react_no, bi, 2, temp_tree); + temp=TreeEval(temp_tree); + if (TreeGetError()==NoEval) + fprintf(stderr, "Unable to compute rate constant (<) in reaction %d.\n", react_no); + TreeKill(temp_tree); + fprintf(code, "%e", -coeff*temp); + for(l=1; l<=NoOfSpec(); l++) { + GetSpecNo(l, name, &charge); + if (IsSpecInReact(react_no, name, charge, &coeff)==1) { + if (coeff<0.0) + fprintf(code, ",%e", -coeff); + else + fprintf(code, ",0"); + } else + fprintf(code, ",0"); + } /* for l */ + break; + } /* switch */ + fprintf(code, "\n"); + } + } /* for j */ + } /* for i */ +} /* Pananakis */ diff --git a/old_src/dimitri.h b/old_src/dimitri.h new file mode 100644 index 0000000..84badfc --- /dev/null +++ b/old_src/dimitri.h @@ -0,0 +1,19 @@ +/************************************************************************** + This code generator is an experimental one. This can from a discuss + with Dimitrios Pananakis, Dundee University, School of Biomedical + Engineering. + + CopyWrong 1994 by + Kenneth Geisshirt (kneth@osc.kiku.dk) + Department of Theoretical Chemistry + H.C. Orsted Institute + Universitetsparken 5 + 2100 Copenhagen + Denmark + + Last updated: 11 April 1994 +****************************************************************************/ + +extern void Pananakis(FILE*); + + diff --git a/old_src/dscml.c b/old_src/dscml.c new file mode 100644 index 0000000..d9d141a --- /dev/null +++ b/old_src/dscml.c @@ -0,0 +1,120 @@ +/* DSCML - Dalimil Snita's Chemical Meta Langauge + CopyWrong by Kenneth Geisshirt, 1992, 1993 + + See kc.tex for details +*/ + +#include +#include +#include +#include "config.h" +#include "symbmath.h" +#include "tableman.h" + +void PrintCharge(FILE *code, double charge) { + +/* This routine prints a proper string for the charge */ + + int i; + + if (charge!=0.0) { + fprintf(code, "("); + if (charge==MAXFLOAT) + fprintf(code, "rad"); + else if (charge>0.0) + for(i=1; i<=(int)charge; i++) + fprintf(code, "+"); + else if (charge<0.0) + for(i=1; i<=-(int)charge; i++) + fprintf(code, "-"); + fprintf(code, ")"); + }; /* if */ +} /* PrintCharge */ + +void DSCML(FILE *code) { + + int i, j, finished, no; + char *name; + double charge, temp, coeff; + Tree tmp; + + name=(char *)malloc(sizeof(char)); + fprintf(code, "%e\t\t\t- number of components\n\n", (double)NoOfSpec()); + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + fprintf(code, "%s\t\t\t- name of %d. component\n", name, i); + fprintf(code, "%e\t\t\t- charge number\n", charge); + temp=GetSpecConst(name, charge, "M"); + if (GetError()==NotFound) + fprintf(stderr, "Molar mass is not defined for %s(%d).\n", name, (int)charge); + else + fprintf(code, "%e\t\t\t- molar mass\n", temp); + temp=GetSpecConst(name, charge, "D"); + if (GetError()==NotFound) + fprintf(stderr, "Diffusivity is not defined for %s(%d).\n", name, (int)charge); + else + fprintf(code, "%e\t\t\t- diffusivity\n", temp); + temp=GetBeginConc(name, charge); + fprintf(code, "%e\t\t\t- initial concentration\n\n", temp); + }; /* for i */ + fprintf(code, "%d\t\t\t- number of reactions\n\n", NoOfReact()); + j=1; + for(i=1; i<=NoOfReact(); i++) { + no=GetReactNo(i-1); + switch (GetReactKind(no)) { + case uni: + finished=GetFirstSpecA(no, name, &charge, &coeff, 0); + fprintf(code, "'&d. reaction\t\t\t- name of the %d. reaction\n", j, j); + tmp=TreeCreate(); + GetRateConst(no, uni, 1, tmp); + TreePrint(tmp, 1, code); + TreeKill(tmp); + fprintf(code, "\t\t\t- kinetic constant\n"); + while (finished==0) { + fprintf(code, "%e\t\t\t- %s(", coeff, name); + PrintCharge(code, charge); + fprintf(code, ")\n"); + finished=GetNextSpecA(name, &charge, &coeff, 0); + }; /* while */ + fprintf(code, "\n"); + j++; + break; /* uni */ + case bi: + finished=GetFirstSpecA(no, name, &charge, &coeff, 0); + fprintf(code, "'&d. reaction\t\t\t- name of the %d. reaction\n", j, j); + tmp=TreeCreate(); + GetRateConst(no, bi, 1, tmp); + TreePrint(tmp, 2, code); + TreeKill(tmp); + fprintf(code, "\t\t\t- kinetic constant\n", temp); + while (finished==0) { + fprintf(code, "%e\t\t\t- %s(", coeff, name); + PrintCharge(code, charge); + fprintf(code, ")\n"); + finished=GetNextSpecA(name, &charge, &coeff, 0); + }; /* while */ + fprintf(code, "\n"); + j++; + fprintf(code, "'&d. reaction\t\t\t- name of the %d. reaction\n", j, j); + tmp=TreeCreate(); + GetRateConst(no, bi, 2, tmp); + TreePrint(tmp, 2, code); + TreeKill(tmp); + fprintf(code, "\t\t\t- kinetic constant\n", temp); + finished=GetFirstSpecA(no, name, &charge, &coeff, 1); + while (finished==0) { + fprintf(code, "%e\t\t\t- %s(", coeff, name); + PrintCharge(code, charge); + fprintf(code, ")\n"); + finished=GetNextSpecA(name, &charge, &coeff, 1); + }; /* while */ + fprintf(code, "\n"); + j++; + break; /* bi */ + case equi: + fprintf(stderr, "Equilibriums are not supported.\n"); + break; /* equi */ + }; /* switch */ + }; /* for i */ +} /* DSCML */ + diff --git a/old_src/dscml.h b/old_src/dscml.h new file mode 100644 index 0000000..2c73090 --- /dev/null +++ b/old_src/dscml.h @@ -0,0 +1,7 @@ +/* Code generator DSCML + CopyWrong by Kenneth Geisshirt, 1993 + + See kc.tex for details +*/ + +extern void DSCML(FILE *); diff --git a/old_src/finn.c-old b/old_src/finn.c-old new file mode 100644 index 0000000..83ee9d4 --- /dev/null +++ b/old_src/finn.c-old @@ -0,0 +1,87 @@ +/************************************************************************* + Finn - a code generator for kc. + CopyWrong by Kenneth Geisshirt, 1993, 1994. + + See kc.tex for details +*************************************************************************/ + +#include +#include +#include +#include "config.h" +#include "symbmath.h" +#include "tableman.h" +#include "misc.h" +#include "codegen.h" + + +void Finn(void) { + + double charge, temp, coeff; + char *name, *rename; + Tree v_temp, tmp, temp_tree; + int i, j, l, react_no, finished, constraint, dyn, dyn2; + int num_of_spec, max_iter; + double eps=1e-18; /* default value */ + struct { double num; } jac_num[MaxSpec][MaxSpec]; + double jac[MaxSpec][MaxSpec]; + double c0[MaxSpec]; + + name=(char *)malloc(sizeof(char)); + rename=(char *)malloc(sizeof(char)); + + GenerateRateExpr(); + GenerateJacobi(); + + num_of_spec=NoOfSpec()+NumOfDynVar()-NumOfConstraint(); + temp=GetConstant("epsa"); + if (GetError()==NoError) + eps=temp; + temp=GetConstant("maxiter"); + if (GetError()==NoError) + max_iter=(int)temp; + else + max_iter=30; + + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) { + c0[dyn-1]=GetBeginConc(name, charge); + dyn++; + } + } + for(i=0; i<=NumOfDynVar(); i) { + GetDynVarNo(i, name); + c0[i+NoOfSpec()-NumOfConstraint()-1]=GetInitValue(name); + } + + EvalJacobian(c0, jac); + + /* Printing jacobi matrix */ + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) { + dyn2=1; + for(j=1; j<=NoOfSpec(); j++) { + GetSpecNo(j, name, &charge); + if (IsSpecInConstraint(name, charge)==0) { + printf("J(%d,%d) = %e\n", dyn, dyn2, jac_num[dyn-1][dyn2-1].num); + dyn2++; + } /* if */ + } /* for j */ + dyn++; + } /* if */ + } /* for i */ + +#ifdef HPUX + hqr2alg(num_of_spec, jac_num, max_iter, eps); +#else + fprintf(stderr, "Only the Jacoby matrix could be evaluated.\n"); +#endif + +} /* Finn */ + + + diff --git a/old_src/iscont.c b/old_src/iscont.c new file mode 100644 index 0000000..d39e515 --- /dev/null +++ b/old_src/iscont.c @@ -0,0 +1,136 @@ +/*************************************************************************** + IScont - a code generator for kc and cont, see [1, 2]. + + CopyWrong 1994 by + Kenneth Geisshirt (kneth@osc.kiku.dk) + Department of Theoretical Chemistry + H.C. Orsted Institute + Universitetsparken 5 + 2100 Copenhagen + Denmark + + See kc.tex for details. + + References: + [1] Chemical waves in reaction-diffusion systems: A numerical study, + K. Geisshirt, 1994 (M.Sc. thesis). + [2] Chaotic Behaviour of Deterministic Dissipative Systems, + M. Marek and I. Screiber, Academia, 1991. + + Last updated: 13 August 1994 +****************************************************************************/ + +#include +#include +#include "config.h" +#include "tableman.h" +#include "symbmath.h" +#include "codegen.h" +#include "misc.h" + +void IScont(FILE *fcode, FILE *input1, FILE *input2) { + + double charge, coeff; + char name[STRING_LENGTH], rename[STRING_LENGTH]; + time_t timer; + int i, j, dyn, form; + + timer=time(&timer); + + InitCodeGenVar(NoOfSpec()+NumOfDynVar()-NumOfConstraint(), + NumOfConstraint()); + GenerateRateExpr(1, 0, 0, 0); + GenerateJacobi(1, 0); + + fprintf(fcode, "C ***********************************************\n"); + fprintf(fcode, "C Warning: This file was generated by kc v%s\n", VERSION); + fprintf(fcode, "C CopyWrong by Kenneth Geisshirt, 1994\n"); + fprintf(fcode, "C %s", ctime(&timer)); + fprintf(fcode, "C ***********************************************\n"); + + fprintf(fcode, " SUBROUTINE MODEL(NDIM,NVAR,N,T,X,F,G,H)\N"); + fprintf(fcode, " IMCLICIT DOUBLE PRECISION(A-H,O-Z)\n"); + fprintf(fcode, " DIMENSION X(NDIM),F(NDIM),G(MDIM,NVAR),H(NDIM,NVAR,NDIM)\n"); + fprintf(fcode, " COMMON/FIXP/PAR(20)\n"); + fprintf(fcode, " COMMON/VARP/ALPHA,BETA,ARG,PER\n"); + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) { + RenameSpec(rename, name, charge); + fprintf(fcode, " DOUBLE PRECISION %s\n", rename); + } /* if */ + } /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(fcode, " DOUBLE PRECISION %s\n", name); + } /* for i */ + for(i=1; i<=NumOfParameter(); i++) { + GetParamNo(i, name, &charge, &form); + if (form==1) + strcpy(rename, name); + else + RenameSpec(rename, name, charge); + fprintf(fcode, " DOUBLE PRECISION %s\n", rename); + } /* for i */ + + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if ((IsSpecInConstraint(name, charge)==0) && + (IsSpecParam(name, charge)!=1)) { + RenameSpec(rename, name, charge); + fprintf(fcode, " %s=X(%d)\n", rename, dyn); + dyn++; + } /* if */ + } /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(fcode, " %s=X(%d)\n", name, i+NoOfSpec()-NumOfConstraint()); + } /* for i */ + GetParamNo(1, name, &charge, &form); + if (GetError()==NoError) { + if (form==2) + RenameSpec(rename, name, charge); + else + strcpy(rename, name); + fprintf(fcode, " %s=alpha\n"); + } else + fprintf(stderr, "IScont: No parameters.\n"); + GetParamNo(2, name, &charge, &form); + if (GetError()==NoError) { + if (form==2) + RenameSpec(rename, name, charge); + else + strcpy(rename, name); + fprintf(fcode, " %s=beta\n", rename); + } /* if */ + + for(i=0; i<(NoOfSpec()+NumOfDynVar()-NumOfConstraint()); i++) { + fprintf(fcode, " f(%d)=", i+1); + TreePrint(fcode, 1, v[i]); + fprintf(fcode, "\n"); + } /* for i */ + fprintf(fcode, " IF(N.EQ.NDIM) RETURN\n"); + + /* printing jacobian + df/dalpha, etc */ + for(i=0; i<(NoOfSpec()+NumOfDynVar()-NumOfConstraint()); i++) + for(j=0; j<=(NoOfSpec()+NumOfDynVar()-NumOfConstraint()); j++) { + fprintf(fcode, " g(%d,%d)=", i+1, j+1); + TreePrint(fcode, 1, jacobi[i][j]); + fprintf(fcode, "\n"); + } /* for j */ + dyn=0; + for(j=1; j<=NoOfSpec(); j++) { + GetSpecNo(j, name, &charge); + if ((IsSpecInConstraint(name, charge)==0) && + (IsSpecParam(name, charge)!=1)) { + RenameSpec(rename, name, charge); + tmp=TreeCreate(); + TreeDerive(tmp, v[dyn], rename); + dyn++; + fprintf(fcode, " g(%d,%d)=", dyn, NoOfSpec()-NumOfConstraint()-NumOfParameter()+NumOfDynVar()+dyn); + TreePrint(tmp, 1, fcode); + fprintf(fcode, "\n"); + TreeKill(tmp); + } /* if */ + } /* for j */ diff --git a/old_src/iscont.h b/old_src/iscont.h new file mode 100644 index 0000000..fc240a1 --- /dev/null +++ b/old_src/iscont.h @@ -0,0 +1,17 @@ +/*************************************************************************** + IScont - a code generator for kc and cont. + + CopyWrong 1994 by + Kenneth Geisshirt (kneth@osc.kiku.dk) + Department of Theoretical Chemistry + H.C. Orsted Institute + Universitetsparken 5 + 2100 Copenhagen + Denmark + + Last updated: 13 August 1994 +****************************************************************************/ + +#include + +extern void IScont(FILE *, FILE *, FILE *); diff --git a/old_src/kincode.c b/old_src/kincode.c new file mode 100644 index 0000000..a64c9fd --- /dev/null +++ b/old_src/kincode.c @@ -0,0 +1,192 @@ +/**************************************************************************** + KinCode - a code generator for kc and KIN. + This is a full operating generator. + + CopyWrong 1992-1994 by + Kenneth Geisshirt (kneth@osc.kiku.dk) + Department of Theoretical Chemistry + H.C. Orsted Institute + Universitetsparken 5 + 2100 Copenhagen + Denmark + + See kc.tex for details + + Last updated: 28 July 1994 +****************************************************************************/ + +#include +#include +#include +#include "config.h" +#include "symbmath.h" +#include "tableman.h" +#include "codegen.h" +#include "misc.h" + +void KinCode(FILE *code) { + + double charge, temp, coeff; + char name[STRING_LENGTH], rename[STRING_LENGTH]; + time_t timer; + Tree v_temp, tmp, temp_tree; + int i, j, react_no, finished, constraint, dyn, dyn2; + + timer=time(&timer); + + InitCodeGenVar(NoOfSpec()+NumOfDynVar()-NumOfConstraint(), + NumOfConstraint()); + GenerateRateExpr(1, 0, 0, 0); + GenerateJacobi(1, 0); + + fprintf(code, "(* %s*)\n", ctime(&timer)); + i=NoOfSpec()+NumOfDynVar()-NumOfConstraint(); /* abuse of i */ + fprintf(code, "CONST\n"); + fprintf(code, " n = %d;\n", i); + fprintf(code, " np = %d;\n\n", i); + temp=GetConstant("mode"); + if (GetError()==NoError) + switch ((int)temp) { + case 0: + fprintf(code, " PERT = FALSE;\n"); + break; + case 1: + fprintf(code, " PERT = TRUE;\n"); + break; + } + else + fprintf(code, " PERT = FALSE;\n"); + fprintf(code, "VAR\n"); + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + RenameSpec(rename, name, charge); + fprintf(code, " %s : LONGREAL;\n", rename); + }; /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(code, " %s : LONGREAL;\n", name); + }; /* for i */ + fprintf(code, " species : ARRAY[1..n] OF STRING[20];\n"); + fprintf(code, "\n(* FILE LIMIT *)\n\n"); + fprintf(code, "PROCEDURE derivsinit;\n"); + fprintf(code, "BEGIN\n"); + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + constraint=IsSpecInConstraint(name, charge); + if (constraint==0) { + if (charge==0.0) + fprintf(code, " species[%d]:='%s';\n", dyn, name); + else { + if (charge==MAXFLOAT) + fprintf(code, " species[%d]:='%s.';\n", dyn, name); + else { + if (charge>0.0) { + fprintf(code, " species[%d]:='%s", dyn, name); + for(j=1; j<=(int)charge; j++) + fprintf(code, "+"); + fprintf(code, "';\n"); + } /* if */ + else { + fprintf(code, " species[%d]:='%s", dyn, name); + for(j=1;j<=-(int)charge;j++) + fprintf(code, "-"); + fprintf(code, "';\n"); + }; /* else */ + }; /* else */ + }; /* else */ + dyn++; + }; /* if */ + }; /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(code, " species[%d]:='%s';\n", i+NoOfSpec(), name); + }; /* for i */ + + GetAndPrintConst("stime", "tb", 1, 1.0, code, 2); + GetAndPrintConst("dtime", "dt", 1, 1.0, code, 2); + GetAndPrintConst("etime", "te", 1, 10.0, code, 2); + GetAndPrintConst("htime", "hb", 1, 1.0, code, 2); + GetAndPrintConst("epsr", "epsr", 1, 1e-3, code, 2); + GetAndPrintConst("epsa", "epsa", 1, 1e-20, code, 2); + GetAndPrintConst("ptime", "perttime", 1, 1.0, code, 2); + GetStrConst("name", name); + if (GetError()==NotFound) + fprintf(code, "name_datafile:='kinwrk.dat';\n\n"); + else + fprintf(code, "name_datafile:='%s';\n\n", name); + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) { + temp=GetBeginConc(name, charge); + fprintf(code, " xx[%d]:=%e;\n", dyn, temp); + dyn++; + }; /* if */ + }; /* for i */ + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) { + temp=GetSpecConst(name, charge, "pert"); + if (GetError()==NoError) + fprintf(code, "xxpert[%d]:=%e;\n", dyn, temp); + else + fprintf(code, "xxpert[%d]:=0.0;\n", dyn); + dyn++; + } /* if */ + } /* for i */ + for(i=1; i<=NumOfExpr(); i++) { + GetDynVarNo(i, name); + fprintf(code, " xx[%d]:=%e;\n", i+NoOfSpec()-NumOfConstraint(), GetInitValue(name)); + } /* for i */ + fprintf(code, "END;\n\n"); + fprintf(code, "PROCEDURE derivs(bj:BOOLEAN; xx_:glnarray; t:LONGREAL;\n"); + fprintf(code, " VAR vv_:glnarray; VAR jj_:glnpbynp);\n"); + fprintf(code, "BEGIN\n"); + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + RenameSpec(rename, name, charge); + constraint=IsSpecInConstraint(name, charge); + if (constraint==0) { + fprintf(code, "%s:=xx_[%d];\n", rename, dyn); + dyn++; + }; /* if */ + }; /* for i*/ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(code, "%s:=xx_[%d];\n", name, i+NoOfSpec()-NumOfConstraint()); + }; /* for i */ + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + RenameSpec(rename, name, charge); + constraint=IsSpecInConstraint(name, charge); + if (constraint>0) { + fprintf(code, "%s:=", rename); + TreePrint(con[constraint-1], 2, code); + fprintf(code, ";\n"); + }; /* if */ + }; /* for i */ + + for(i=1; i<=(NoOfSpec()-NumOfConstraint()+NumOfDynVar()); i++) { + fprintf(code, "vv_[%d]:=", i); + TreePrint(v[i-1], 2, code); + fprintf(code, ";\n"); + } /* for i */ + + fprintf(code, "IF bj THEN BEGIN\n"); + for(i=1; i<=(NoOfSpec()-NumOfConstraint()+NumOfDynVar()); i++) + for(j=1; j<=(NoOfSpec()-NumOfConstraint()+NumOfDynVar()); j++) { + temp=TreeEval(jacobi[i-1][j-1]); + if (TreeGetError()==NoEval) { + fprintf(code, "jj_[%d,%d]:=", i, j); + TreePrint(jacobi[i-1][j-1], 2, code); + fprintf(code, ";\n"); + } /* if */ + else + if (temp!=0.0) + fprintf(code, "jj_[%d,%d]:=%e;\n", i, j, temp); + } /* for j */ + fprintf(code, " END\nEND;\n"); +} /* KinCode */ diff --git a/old_src/kincode.h b/old_src/kincode.h new file mode 100644 index 0000000..9992687 --- /dev/null +++ b/old_src/kincode.h @@ -0,0 +1,8 @@ +/**************************************************************************** + Code generator KinCode + CopyWrong by Kenneth Geisshirt, 1993 + + See kc.tex for details. +****************************************************************************/ + +extern void KinCode(FILE *); diff --git a/old_src/kksolver.c.old b/old_src/kksolver.c.old new file mode 100644 index 0000000..eafc483 --- /dev/null +++ b/old_src/kksolver.c.old @@ -0,0 +1,1294 @@ +/*************************************************************************** + This source file contains various numerical solvers for ordinary + differential equations. + + The routines associated by each solver compute one and only one time + step. + + + CopyWrong 1994 by + Kenneth Geisshirt (kneth@osc.kiku.dk) and + Keld Nielsen (kn@osc.kiku.dk) + Department of Theoretical Chemistry + H.C. Orsted Institute + Universitetsparken 5 + 2100 Copenhagen + Denmark + + References: + [1] W.H. Press, et al. Numerical Recipes in C, 2. edition. + Cambridge University Press, 1992. + [2] D.A. Calahan. (1968). Proc. IEEE, April 1968, p. 744. + [3] P. Kaps, and P. Rentrop. (1979). Numer. Math, 33, pp. 55-68. + [4] K. Geisshirt. Chemical Waves in Reaction-Diffusion Systems: A Numerical + Study. (M.Sc. thesis, University of Copenhagen), 1994. + [5] M. Kubicek, and M. Marek, Computational Methods In Bifucation Theory + And Dissipative Structures, Springer-Verlag, New York, 1983. + [6] J.R. Cash, and A.H. Karp. (1990). ACM Trans. Math. Softw. 16, + pp. 201-222. + [7] P. Kaps, S.W.H. Poon, and T.D. Bui. (1985). Computing. 34, pp. 17-40. + [8] P. Deuflhard, G. Bader, and U. Nowak. (1981). pp. 38-55. + In K.H. Ebert, P. Deuflhard, and W. Jager (eds.). Modelling of Chemical + Reaction Systems. Springer Series in Chemical Physics, Vol. 18. + Springer-Verlag, Berlin, 1981. + [9] E. Hairer, and G. Wanner. Solving Ordinary Differential Equations II. + Springer Series In Computational Mathematics, Vol. 14. Springer-Verlag, + Berlin, 1991. + [10] D. Kincaid, and W. Cheney. Numerical Analysis. Brooks/Cole, 1991. + + Last updated: 1 September 1994 by KG +****************************************************************************/ + +#define VERSION_ "0.99b" + +#include +#include +#include + +/*************************************************************************** + The matrix manipulating routines like linear equation solvers are all + implemented in a small library. It is imported below. + + Routines for integrating functions are also imported below. +****************************************************************************/ + +#include "matrix.h" +#include "integr.h" + +/*************************************************************************** + The program has a number of global variables. Each variable has an + underscore as the last character in order to eliminate conflicts with + names in the model. + + time_ The independent variable of the ODEs + stime_ Initial value for the independent variable. Default: 0 + etime_ Final value for the independent variable. Default: 200 + dtime_ Output at equidistant points. Also functioning as the largest + possible stepsize. Default: 2.0 + htime_ Stepsize + epsr_ Relative error tolerance. Default: 1.0E-5 + epsa_ Absolute error tolerance. Default: 1.0E-15 + epsmin_ Relative machine precision. Default: 1.0E-16 + timenew_ New value of the independent variable before a new step of + integration is accepted. + htimenew_ New value of the stepsize before a new step of integration is + accepted. + errlim_ The ratio between the estimate of the (scaled) local truncation + error and the relative tolenrance. + If errlim_>1.0 the steplength (hstep_) is rejected otherwise + the step of integration is accepted. + thtime_ The value of the independent variable for the next output. + step_adjustment_factor + Safety factor in the calculation of a new stepsize. Default: 0.9 + order_of_method + The order of the integration method + steplimit_increase + Upper bound for the ratio of two consecutive steps. Default: 1.5 + steplimit_decrease + Lower bound for the ratio of two consecutive steps. Default: 0.5 + step_increase_factor == -1/order_of_method. + Used in the calculation of the new steplength. + errcon_ Smallest value of errlim_, [1] + htimemin_ The minimal allowed stepsize. Default: Relative machine + precision. + + mainmode_ 1==ODEs, 2==PDEs. Default: 1 + solver_ Method of integration. Default: 1 + prnmode_ Mode of output. 0: Equidistant and extrema points. + 1: Only equidistant points. + Default: 0 + scaling_ Method of scaling. 0: Strict relative error [8], + 1: Scaling device in error estimate due + to Deuflhard et al., [8]. + + pert_ Keeps track of pertubation of the differential equations. + ptime_ Time for a perturbation + outfile Handler to output file. + i Simple counter. + datafilename_Name of output file. + + equa Number of differential equations. + ns_ = equa-1 Number of dependent variables in a nonautonomous + differential equations. + xnew_ New values of the dependent variables. + xerr_ Estimate of the unscaled local truncation errors for the + dependent variables. + + x_inte_min Left limit of integrals. + x_inte_max Right limit of integrals. + + The file model.c contains the C-code that depends on a specific model. + It is generated by kc, see [4]. +*****************************************************************************/ + +static double time_, stime_, etime_, dtime_, htime_, epsr_, epsa_; +static double epsmin_, timenew_, htimenew_, errlim_, thtime_, ptime_; +static double step_adjustment_factor, order_of_method, steplimit_increase; +static double steplimit_decrease, step_increase_factor, errcon_, htimemin_; +static int mainmode_, solver_, prnmode_, scaling_, pert_=1, i; +static FILE *outfile; +static char datafilename_[35]; +static double x_inte_min, x_inte_max; + +#include "model.c" + +static const int ns_ = equa-1; +static double xnew_[equa], xerr_[equa]; + + +/************************************************************************** + Routine kcerror print a failure that occuring in the calculation and + the program is terminated. +***************************************************************************/ + +void kcerror(char *str) { + + fprintf(stderr, "Failure in numerical integration: %s.\n", str); + fprintf(stderr, "Aborting the program - sorry.\n"); + exit(-1); +} /* kcerror */ + + +/**************************************************************************** + This section contains various service routines. They are: + + o Gaussian - computes a special Gaussian function. + o FindMachEps - find the machine's precision + o MaxVec - find the (abs) largest number in a vector + o MaxPair - find the largest of two numbers + o MinPair - find the smallest of two numbers + o PrintState - print the independent variable (time_) and the dependent + variables (x_). The data is written to the disk. The file + handler is outfile. The output is in ASCII characters, and + can be found in the following way: + time_ x_[0] x_[1] ... x_[equa-1] x_[equa] + Three modes of output. prnmode_=0: Equidistant and extrema + points printed, and prnmode_=1: Only equidistant points. + If prnmode_=2, it is used for quantum mech. computation. + Default: 0. +*****************************************************************************/ + +double Gaussian(double x_, double *params_) { + + return (exp(pow(x_-params_[0], 2.0)*2.0*params_[1]+2.0*params_[2])); +} /* Gaussian */ + +double FindMachEps(void) { + + double temp=1.0; + + while ((1.0+temp)!=1.0) + temp/=10.0; + return temp; +} /* FindMachEps */ + + +double MaxVec(int nosp_, double x_[equa]) { + + double temp1_=0.0, temp2_; + int i_; + + for(i_=0; i_temp1_) + temp1_=temp2_; + } /* for i_ */ + return temp1_; +} /* MaxVec */ + + +double MaxPair(double x_, double y_) { + + if (x_>y_) + return x_; + else + return y_; +} /* MaxPair */ + + +double MinPair(double x_, double y_) { + + if (x_c2_[i_]) && (c2_[i_]x_[i_]))) + flag_=1; + if (flag_) { + fprintf(outfile, "%e ", time_); + for(i_=0; i_(twiddle_[present_][0]*quit_[present_][0])) { /* abandon */ + esttol_=ERR_[0]/quit_[present_][0]; + htime_temp*=MaxPair(0.2, step_adjustment_factor/esttol_); + if (htime_temp(twiddle_[present_][1]*quit_[present_][1])) { + if (ERR_[0]<1.0) { + error_term=0.0; + for(i_=0; i_1.0) { + for(i_=0; i_<=1; i_++) { + if (ERR_[i_]/quit_[present_][i_]epsmin_) { + htime_temp*=MaxPair(0.2, step_adjustment_factor/esttol_); + if (htime_tempepsmin_) { + htime_temp*=MaxPair(0.2, step_adjustment_factor/esttol_); + for(j_=0; j_<=1; j_++) { + Q_[j_]=ERR_[j_]/ERR_[3]; + if (Q_[j_]>quit_[present_][j_]) + Q_[j_]=MinPair(Q_[j_], 10.0*quit_[present_][j_]); + else + Q_[j_]=MaxPair(Q_[j_], 2.0/3.0*quit_[present_][j_]); + quit_[(present_+1)%2][j_]=MaxPair(1.0, MinPair(10000.0, Q_[j_])); + twiddle_[(present_+1)%2][j_]=twiddle_[present_][j_]; + } /* for j_ */ + } /* if */ + order_used=5; + break; /* leave loop now! */ + } /* if else */ + } /* for (infinite loop) */ + + switch (order_used) { + case 2: + for(i_=0; i_etime_) + kcerror("stime > etime"); + + /* Program aborted: If initial time is less than the zero */ + if (time_<0.0) + kcerror("stime < 0.0"); + + /* Program aborted: If initial stepsize is less than the zero */ + if (htime_<0.0) + kcerror("htime < 0.0"); + + /* Program aborted: If requested output at eqvidistant points + is not resonable */ + if (dtime_<0.0) + kcerror("dtime < 0.0"); + + /* Smallest absoulte error not less than relative machine precision */ + if (epsa_=0.5*dtime_) + htime_=0.5*dtime_; + + /* Opening output file */ + outfile=fopen(datafilename_, "w"); + fprintf(outfile, "# Output from kksolver v%s, %s", VERSION_, + ctime(&timer_)); + fprintf(outfile, "# CopyWrong 1994 by Keld Nielsen and Kenneth Geisshirt\n"); + + /* Scaling method: Initialization */ + if (scaling_==0) { /* Strict relative error */ + for(i=0; i1.0) { /* The new stepsize is not accepted if the + local error estimate is larger than the + relative error tolerance */ + htime_=htimenew_; + if (steprejection_!=2) { + steprejection_++; + } else { /* If the new stepsize has been rejected more + than two times the new stepsize is drastical + reduced; h_new= h_old/10. + Method suggested by Hairer and Wanner [9] */ + steprejection_=0; + htime_= htimenew_/10.0; + } /* else */ + } else { /* The new stepsize is accepted if the local error + estimate is less or equal to the relative error + tolerance */ + timenew_=time_+htime_; + steprejection_=0; + if (timenew_ +#include +#include +#include +#include "config.h" +#include "symbmath.h" +#include "tableman.h" +#include "codegen.h" +#include "misc.h" + +void KnCont(FILE *code) { + + double charge, temp, coeff, temp1, temp2; + char *name, *rename; + time_t timer; + Tree v_temp, tmp, temp_tree, tmp2; + int i, j, k, l, react_no, finished, constraint, dyn, dyn2, dyn3, form; + int NumbOfParams, NumbOfDynVars; + int need_dd_jac; + + name=StringAlloc(); + rename=StringAlloc(); + timer=time(&timer); + NumbOfParams=NumOfParameter(); + NumbOfDynVars=NoOfSpec()-NumOfConstraint()+NumOfDynVar(); + if ((NumbOfParams==0) || (NumbOfParams>2)) { + fprintf(stderr, "KNCont: Wrong number of parameters - should be either 1 or 2.\n"); + return; + } /* if */ + + InitCodeGenVar(NoOfSpec()+NumOfDynVar()-NumOfConstraint(), + NumOfConstraint()); + GenerateRateExpr(); + GenerateJacobi(); + if (NumbOfParams==2) { + GenerateHessian(); + GenerateKeldian(); + } /* if */ + + fprintf(code, "(******************************************************\n"); + fprintf(code, " WARNING: This file was generated by kc v%s\n", + VERSION); + fprintf(code, " CopyWrong 1994 by Kenneth Geisshirt.\n"); + fprintf(code, " %s", ctime(&timer)); + fprintf(code, "*******************************************************)\n"); + fprintf(code, "CONST\n"); + fprintf(code, "n=%d;\n", NumbOfDynVars); + fprintf(code, "np=%d;\n", NumbOfDynVars); + fprintf(code, "numparam=%d;\n\n", NumbOfParams); + fprintf(code, "VAR\n"); + fprintf(code, "NeedDDJac:BOOLEAN;\n"); + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + RenameSpec(rename, name, charge); + fprintf(code, "%s:LONGREAL;\n", rename); + } /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(code, "%s:LONGREAL;\n", name); + } /* for i */ + for(i=1; i<=(NoOfReact()+NumOfExpr()); i++) { + fprintf(code, "(* r%d : LONGREAL; *)\n", i-1); + } /* for i */ + for(i=1; i<=NumOfParameter(); i++) { + GetParamNo(i, name, &charge, &form); + if (form==1) + strcpy(rename, name); + else + RenameSpec(rename, name, charge); + fprintf(code, "%s:LONGREAL;\n", rename); + } /* for i */ + fprintf(code, "species : ARRAY[1..n] OF STRING[20];\n"); + fprintf(code, "\n(* FILE LIMIT *)\n\n"); + + fprintf(code, "PROCEDURE derivs(bj:BOOLEAN; xx_:glnarray; t:LONGREAL;\n"); + fprintf(code, " VAR vv_:glnarray; VAR jj_:glnpbynp);\n"); + fprintf(code, "BEGIN\n"); + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + RenameSpec(rename, name, charge); + constraint=IsSpecInConstraint(name, charge); + if (constraint==0) { + fprintf(code, "%s:=xx_[%d];\n", rename, dyn); + dyn++; + } /* if */ + } /* for i*/ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(code, "%s:=xx_[%d];\n", name, i+NoOfSpec()-NumOfConstraint()); + } /* for i */ + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + RenameSpec(rename, name, charge); + constraint=IsSpecInConstraint(name, charge); + if (constraint>0) { + fprintf(code, "%s:=", rename); + TreePrint(con[constraint-1], 2, code); + fprintf(code, ";\n"); + }; /* if */ + }; /* for i */ + + for(i=1; i<=NumbOfDynVars; i++) { + fprintf(code, "vv_[%d]:=", i); + TreePrint(v[i-1], 2, code); + fprintf(code, ";\n"); + } /* for i */ + fprintf(code, "IF bj THEN BEGIN\n"); + for(i=1; i<=NumbOfDynVars; i++) { + for(j=1; j<=NumbOfDynVars; j++) { + fprintf(code, "jj_[%d, %d]:=", i, j); + TreePrint(jacobi[i-1][j-1], 2, code); + fprintf(code, ";\n"); + } /* for j */ + } /* for i */ + fprintf(code, "END\nEND;\n"); + + /* Diff. with respect to parameters, i.e. df/dalpha */ + fprintf(code, "PROCEDURE derivsdalfa(bjac: BOOLEAN;xx_: glnarray; VAR gg: glnpbynp);\n"); + fprintf(code, "BEGIN\n"); + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if ((IsSpecInConstraint(name, charge)==0) && + (IsSpecParam(name, charge)!=1)) { + RenameSpec(rename, name, charge); + fprintf(code, "%s:=xx_[%d];\n", rename, dyn); + dyn++; + } /* if */ + } /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(code, "%s:=xx_[%d];\n", name, i+NoOfSpec()-NumOfConstraint()); + } /* for i */ + switch (NumbOfParams) { + case 1: + GetParamNo(1, name, &charge, &form); + if (form==2) + RenameSpec(rename, name, charge); + else + strcpy(rename, name); + fprintf(code, "%s:=xx_[n1];\n", rename); + fprintf(code, "IF bjac THEN\nBEGIN\n"); + GetParamNo(1, name, &charge, &form); + if (form==1) + strcpy(rename, name); + else + RenameSpec(rename, name, charge); + for(j=0; j=1; i--) { + GetParamNo(i, name, &charge, &form); + if (form==2) + RenameSpec(rename, name, charge); + else + strcpy(rename, name); + fprintf(code, "%s:=xx_[n%d];\n", rename, NumbOfParams+1-i); + } /* for i */ + fprintf(code, "IF bj THEN BEGIN\n"); + GetParamNo(2, name, &charge, &form); + if (form==2) + RenameSpec(rename, name, charge); + else + strcpy(rename, name); + for(j=0; j0.0) + fprintf(code, "hdir[%d]:=1\n;", dyn); + else + fprintf(code, "hdir[%d]:=-1\n;", dyn); + fprintf(code, "hmax[%d]:=%e;\n", dyn, fabs(temp)); + } /* if */ + temp=GetSpecConst(name, charge, "Hfbxmax"); + if (GetError()==NoError) + fprintf(code, "xupp[%d]:=%e;\n", dyn, temp); + temp=GetSpecConst(name, charge, "Hfbxmin"); + if (GetError()==NoError) + fprintf(code, "xlow[%d]:=%e;\n", dyn, temp); + temp=GetSpecConst(name, charge, "Hfbpref"); + if (GetError()==NoError) + fprintf(code, "pref[%d]:=%e;\n", dyn, temp); + } /* if */ + } /* for i */ + for(i=1; i<=NumOfParameter(); i++) { + GetParamNo(i, name, &charge, &form); + if (form==1) { + GetInitParam(name, &temp); + fprintf(code, "xx[n%d]:=%e;\n", i, temp); + temp=GetDirectForParam(name); + if (temp>0.0) + fprintf(code, "ndir[n%d]:=1;\n", i); + else + fprintf(code, "ndir[n%d]:=-1;\n", i); + GetDeltaParam(name, &temp); + fprintf(code, "hmax[n%d]:=%e;\n", i, fabs(temp)); + GetLowHighPrefParam(name, &temp, &temp1, &temp2); + fprintf(code, "xlow[n%d]:=%e;\n", i, temp); + fprintf(code, "xupp[n%d]:=%e;\n", i, temp1); + if ((temp2>1.0) && (temp2<0.0)) + fprintf(code, "KnCont: Pref. for %s must between 0 and 1.\n", name); + else + fprintf(code, "pref[n%d]:=%e;\n", i, temp2); + } /* if */ + else { + GetInitConc(name, charge, &temp); + fprintf(code, "xx[n%d]:=%e;\n", i, temp); + temp=GetDirectForConc(name, charge); + if (temp>0.0) + fprintf(code, "ndir[n%d]:=1;\n", i); + else + fprintf(code, "ndir[n%d]:=-1;\n", i); + GetDeltaConc(name, charge, &temp); + fprintf(code, "hmax[n%d]:=%e;\n", i, fabs(temp)); + GetLowHighPrefConc(name, charge, &temp, &temp1, &temp2); + fprintf(code, "xlow[n%d]:=%e;\n", i, temp); + fprintf(code, "xupp[n%d]:=%e;\n", i, temp1); + if ((temp2>1.0) && (temp2<0.0)) + fprintf(code, "KnCont: Pref. for %s(%d) must between 0 and 1.\n", + name, (int)charge); + else + fprintf(code, "pref[n%d]:=%e;\n", i, temp2); + } /* else */ + } /* for i */ + fprintf(code, "END;\n"); + fprintf(code, "PROCEDURE derivsinit;\n"); + fprintf(code, "BEGIN\n"); + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + constraint=IsSpecInConstraint(name, charge); + if ((constraint==0) && (IsSpecParam(name, charge)==0)) { + if (charge==0.0) + fprintf(code, "species[%d]:='%s';\n", dyn, name); + else { + if (charge==MAXFLOAT) + fprintf(code, "species[%d]:='%s.';\n", dyn, name); + else { + if (charge>0.0) { + fprintf(code, "species[%d]:='%s", dyn, name); + for(j=1; j<=(int)charge; j++) + fprintf(code, "+"); + fprintf(code, "';\n"); + } /* if */ + else { + fprintf(code, "species[%d]:='%s", dyn, name); + for(j=1;j<=-(int)charge;j++) + fprintf(code, "-"); + fprintf(code, "';\n"); + } /* else */ + } /* else */ + } /* else */ + dyn++; + }; /* if */ + }; /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(code, "species[%d]:='%s';\n", i+NoOfSpec(), name); + }; /* for i */ + + GetAndPrintConst("stime", "tb", 1, 1.0, code, 2); + GetAndPrintConst("dtime", "dt", 1, 1.0, code, 2); + GetAndPrintConst("etime", "te", 1, 10.0, code, 2); + GetAndPrintConst("htime", "hb", 1, 1.0, code, 2); + GetAndPrintConst("epsr", "epsr", 1, 1e-3, code, 2); + GetAndPrintConst("epsa", "epsa", 1, 1e-20, code, 2); + GetStrConst("name", name); + if (GetError()==NotFound) + fprintf(code, "name_datafile:='kinwrk.dat';\n\n"); + else + fprintf(code, "name_datafile:='%s';\n\n", name); + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) { + temp=GetBeginConc(name, charge); + fprintf(code, "xx[%d]:=%e;\n", dyn, temp); + dyn++; + } /* if */ + } /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(code, "xx[%d]:=%e;\n", i+NoOfSpec()-NumOfConstraint(), + GetInitValue(name)); + } /* for i */ + fprintf(code, "END;\n\n"); + + fprintf(code, "PROCEDURE hopfinit;\nBEGIN\nderivsinit;\n"); + fprintf(code, "need_dd_jac:=%s;\n", + (need_dd_jac==1)?"TRUE":"FALSE"); + fprintf(code, "END;\n"); + + + StringFree(name); + StringFree(rename); +} /* KnCont */ + diff --git a/old_src/kncc.c b/old_src/kncc.c new file mode 100644 index 0000000..e2ea1b7 --- /dev/null +++ b/old_src/kncc.c @@ -0,0 +1,193 @@ +/*************************************************************************** + KnCC - a code generator for kc and KN's continuation program. + + CopyWrong 1993-1994 by + Kenneth Geisshirt (kneth@osc.kiku.dk) + Department of Theoretical Chemistry + H.C. Orsted Institute + Universitetsparken 5 + 2100 Copenhagen + Denmark + + See kc.tex for details. + + Last updated: 11 May 1995 by KN +*****************************************************************************/ + +#include +#include +#include +#include +#include "config.h" +#include "symbmath.h" +#include "tableman.h" +#include "codegen.h" +#include "misc.h" + +void KnCC(FILE *ccode, FILE *hcode) { + + double charge, temp, coeff, temp1, temp2; + char *name, *rename; + time_t timer; + Tree v_temp, tmp, temp_tree, tmp2; + int i, j, k, l, react_no, finished, constraint, dyn, dyn2, dyn3, form; + int NumbOfParams, NumbOfDynVars; + int need_dd_jac, BfErrorCode; + + name=StringAlloc(); + rename=StringAlloc(); + timer=time(&timer); + NumbOfParams=NumOfParameter(); + NumbOfDynVars=NoOfSpec()-NumOfConstraint()+NumOfDynVar(); + if ((NumbOfParams==0) || (NumbOfParams>2)) { + fprintf(stderr, "KNCont: Wrong number of parameters - should be either 1 or 2.\n"); + return; + } /* if */ + + InitCodeGenVar(NoOfSpec()+NumOfDynVar()-NumOfConstraint(), + NumOfConstraint(), NoOfReact()); + GenerateRateExpr(); + GenerateJacobi(); + + fprintf(ccode, "c ****************************************************\n"); + fprintf(ccode, "c WARNING: This file was generated by kc v%s\n", + VERSION); + fprintf(ccode, "c CopyWrong 1994 by Kenneth Geisshirt.\n"); + fprintf(ccode, "c %s", ctime(&timer)); + fprintf(ccode, "c ****************************************************\n"); + fprintf(ccode, "\n"); + + /* printing derivs */ + + fprintf(ccode, " subroutine model(ndim,nvar,n,t,x,f,g)\n"); + fprintf(ccode, "\n"); + fprintf(ccode, "c specification of the user's problem\n"); + fprintf(ccode, "c right hand sides and jacobi matrix of\n"); + fprintf(ccode, "c the model equations are evaluated here\n"); + fprintf(ccode, "c\n"); + fprintf(ccode, "c t : time (explicitly occures only for fodes)\n"); + fprintf(ccode, "c x() : array ndim state space variables\n"); + fprintf(ccode, "c f() : array ndim right hand sides depending on x;alpha,beta,par()\n"); + fprintf(ccode, "c (in addition f depends explicitly on t for fodes)\n"); + fprintf(ccode, "c g(,): ndim by ndim+2 matrix of first derivatives,\n"); + fprintf(ccode, "c g = [df/dx,df/dalpha,df/dbeta]\n"); + fprintf(ccode, "\n"); + fprintf(ccode, "c -------------------------------------------------------\n"); + fprintf(ccode, " implicit real*8(a-h,o-z)\n"); + fprintf(ccode, " dimension x(ndim),f(ndim),g(ndim,nvar)\n"); + fprintf(ccode, " common/fixp/dummy(40)\n"); + fprintf(ccode, " common/varp/"); + for(i=1; i<=NumbOfParams; i++) { + GetParamNo(i, name, &charge, &form); + if (form==2) + RenameSpec(rename, name, charge); + else + strcpy(rename, name); + fprintf(ccode, "%s,", rename); + } /* for i */ + fprintf(ccode, "arg,per\n"); + fprintf(ccode, "c -------------------------------------------------------\n"); + + + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + RenameSpec(rename, name, charge); + fprintf(ccode, " double %s\n", rename); + } /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(ccode, "double %s\n", name); + } /* for i */ + + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + RenameSpec(rename, name, charge); + constraint=IsSpecInConstraint(name, charge); + if (constraint==0) { + fprintf(ccode, " %s = x(%d)\n", rename, dyn); + dyn++; + } /* if */ + } /* for i*/ + fprintf(ccode, "\n"); + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(ccode, " %s = x(%d)\n", name, i+NoOfSpec()-NumOfConstraint()); + } /* for i */ + fprintf(ccode, "\n"); + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + RenameSpec(rename, name, charge); + constraint=IsSpecInConstraint(name, charge); + if (constraint>0) { + fprintf(ccode, " %s = ", rename); + TreePrint(con[constraint-1], 1, ccode); + fprintf(ccode, "\n"); + }; /* if */ + }; /* for i */ + fprintf(ccode, "\n"); + + for(i=1; i<=NumbOfDynVars; i++) { + fprintf(ccode, " f(%d) = ", i); + TreePrint(v[i-1], 1, ccode); + fprintf(ccode, "\n"); + } /* for i */ + fprintf(ccode, "\n"); + + for(i=1; i<=NumbOfDynVars; i++) { + for(j=1; j<=NumbOfDynVars; j++) { + temp=TreeEval(jacobi[i-1][j-1]); + fprintf(ccode, " g(%d,%d) = ", i, j); + TreePrint(jacobi[i-1][j-1], 1, ccode); + fprintf(ccode, "\n"); + } /* for j */ + fprintf(ccode, "\n"); + } /* for i */ + GetParamNo(1, name, &charge, &form); + if (form==1) + strcpy(rename, name); + else + RenameSpec(rename, name, charge); + for(j=0; j +#include +#include +#include +#include "config.h" +#include "symbmath.h" +#include "tableman.h" +#include "codegen.h" +#include "misc.h" + +extern void KnCont(FILE *, FILE *); diff --git a/old_src/knccold.c b/old_src/knccold.c new file mode 100644 index 0000000..9387df9 --- /dev/null +++ b/old_src/knccold.c @@ -0,0 +1,761 @@ +/*************************************************************************** + KnCC - a code generator for kc and KN's continuation program. + + CopyWrong 1993-1994 by + Kenneth Geisshirt (kneth@osc.kiku.dk) + Department of Theoretical Chemistry + H.C. Orsted Institute + Universitetsparken 5 + 2100 Copenhagen + Denmark + + See kc.tex for details. + + Last updated: 11 May 1995 by KN +*****************************************************************************/ + +#include +#include +#include +#include +#include "config.h" +#include "symbmath.h" +#include "tableman.h" +#include "codegen.h" +#include "misc.h" + +void KnCC(FILE *ccode, FILE *hcode) { + + double charge, temp, coeff, temp1, temp2; + char *name, *rename; + time_t timer; + Tree v_temp, tmp, temp_tree, tmp2; + int i, j, k, l, react_no, finished, constraint, dyn, dyn2, dyn3, form; + int NumbOfParams, NumbOfDynVars; + int need_dd_jac, BfErrorCode; + + name=StringAlloc(); + rename=StringAlloc(); + timer=time(&timer); + NumbOfParams=NumOfParameter(); + NumbOfDynVars=NoOfSpec()-NumOfConstraint()+NumOfDynVar(); + if ((NumbOfParams==0) || (NumbOfParams>2)) { + fprintf(stderr, "KNCont: Wrong number of parameters - should be either 1 or 2.\n"); + return; + } /* if */ + + InitCodeGenVar(NoOfSpec()+NumOfDynVar()-NumOfConstraint(), + NumOfConstraint(), NoOfReact()); + GenerateRateExpr(); + GenerateJacobi(); + if (NumbOfParams==2) { + GenerateHessian(); + } /* if */ + + fprintf(hcode, "(******************************************************\n"); + fprintf(hcode, " WARNING: This file was generated by kc v%s\n", + VERSION); + fprintf(hcode, " CopyWrong 1994 by Kenneth Geisshirt.\n"); + fprintf(hcode, " %s", ctime(&timer)); + fprintf(hcode, "*******************************************************)\n"); + fprintf(hcode, "CONST\n"); + fprintf(hcode, "n=%d;\n", NumbOfDynVars); + fprintf(hcode, "np=%d;\n", NumbOfDynVars); + fprintf(hcode, "VAR\n"); + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + RenameSpec(rename, name, charge); + fprintf(hcode, "%s:LONGREAL;\n", rename); + } /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(hcode, "%s:LONGREAL;\n", name); + } /* for i */ + for(i=1; i<=NumOfParameter(); i++) { + GetParamNo(i, name, &charge, &form); + if (form==1) + strcpy(rename, name); + else + RenameSpec(rename, name, charge); + fprintf(hcode, "%s:LONGREAL;\n", rename); + } /* for i */ + fprintf(hcode, "species : ARRAY[1..n] OF STRING[20];\n"); + + fprintf(ccode, "(******************************************************\n"); + fprintf(ccode, " WARNING: This file was generated by kc v%s\n", + VERSION); + fprintf(ccode, " CopyWrong 1994 by Kenneth Geisshirt.\n"); + fprintf(ccode, " %s", ctime(&timer)); + fprintf(ccode, "*******************************************************)\n"); + + /* printing Hessian */ + fprintf(ccode, "void djacobian(double *xx_, double ***dS_)\n"); + fprintf(ccode, "{\n"); + switch (NumbOfParams) { + case 1: + need_dd_jac=0; + break; + case 2: + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if ((IsSpecInConstraint(name, charge)==0) && + (IsSpecParam(name, charge)!=1)) { + RenameSpec(rename, name, charge); + fprintf(ccode, "%s=x(%d);\n", rename, dyn); + dyn++; + } /* if */ + } /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(ccode, "%s=x(%d);\n", rename, + i+NoOfSpec()/NumOfConstraint()); + } /* for i */ + need_dd_jac=0; + +/* + for(i=0; i0) { + fprintf(ccode, "%s=", rename); + TreePrint(con[constraint-1], 3, ccode); + fprintf(ccode, ";\n"); + }; /* if */ + }; /* for i */ + + for(i=1; i<=NumbOfDynVars; i++) { + fprintf(ccode, "f(%d) = ", i); + TreePrint(v[i-1], 3, ccode); + fprintf(ccode, ";\n"); + } /* for i */ + fprintf(ccode, "if (bj_==1) {\n"); + + for(i=1; i<=NumbOfDynVars; i++) { + for(j=1; j<=NumbOfDynVars; j++) { + temp=TreeEval(jacobi[i-1][j-1]); + /* if (TreeGetError()==NoEval) { +*/ fprintf(ccode, "g(%d,%d) = ", i, j); + TreePrint(jacobi[i-1][j-1], 3, ccode); + fprintf(ccode, ";\n"); + /* } /* if */ + + } /* for j */ + } /* for i */ + fprintf(ccode, "}\n} /* derivs */\n\n"); + + /* End of printing derivs */ + + + /* Printing derivsinit */ + + fprintf(ccode, "void derivsinit(void)\n"); + fprintf(ccode, "{\n"); + + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) { + RenameSpec(rename, name, charge); + fprintf(ccode, "species[%d]='%s';\n", dyn, rename); + dyn++; + } /* if */ + } /* for i */ + + /* maaske skal foelgende benyttes istedet for det naeste */ + /* for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(ccode, "species[%d]='%s';\n", + i+NoOfSpec()-NumOfConstraint()-IsNotAutoSystem()-1, name); + }*/ /* for i */ + + /* maaske foelgende godt nok */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(ccode, "species[%d]='%s';\n", i+NoOfSpec(), name); + }; /* for i */ + + GetAndPrintConst("epsr", "epsr", 1, 1e-3, ccode, 3); + GetAndPrintConst("epsa", "epsa", 1, 1e-20, ccode, 3); + GetStrConst("datafile", name); + if (GetError()==NotFound) + fprintf(ccode, "name_datafile='kinwrkdat';\n"); + else + fprintf(ccode, "name_datafile='%s';\n", name); + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) { + temp=GetBeginConc(name, charge); + fprintf(ccode, "xx[%d]=%e;\n", dyn, temp); + dyn++; + } /* if */ + } /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(ccode, "xx[%d]=%e;\n", i+NoOfSpec()-NumOfConstraint(), + GetInitValue(name)); + } /* for i */ + + /* constant elements of the Jacobian matrix */ + for(i=1; i<=NumbOfDynVars; i++) { + for(j=1; j<=NumbOfDynVars; j++) { + temp=TreeEval(jacobi[i-1][j-1]); + if (TreeGetError()==TreeNoError) { + fprintf(ccode, "jacobi[%d, %d]= %e;\n", i, j, temp); + } /* if */ + } /* for j */ + } /* for i */ + + fprintf(ccode, "} /* derivs */\n\n"); + + /* End of printing derivsinit */ + + /* NumbOfParams: 1 - sp_dalfa and derpinit are printed, 2 - hf_dalfa and hopfinit are printed */ + + switch (NumbOfParams) { + case 1: + /* Printing sp_dalfa */ + fprintf(ccode, "void sp_dalfa(int bj_,double xx_, double **gg_)\n"); + fprintf(ccode, "{\n"); + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if ((IsSpecInConstraint(name, charge)==0) && + (IsSpecParam(name, charge)!=1)) { + RenameSpec(rename, name, charge); + fprintf(ccode, "%s=xx_[%d];\n", rename, dyn); + dyn++; + } /* if */ + } /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(ccode, "%s=xx_[%d];\n", name, i+NoOfSpec()-NumOfConstraint()); + } /* for i */ + + GetParamNo(1, name, &charge, &form); + if (form==2) + RenameSpec(rename, name, charge); + else + strcpy(rename, name); + fprintf(ccode, "%s=xx_[n1];\n", rename); + fprintf(ccode, "if (bj_==1) \n{\n"); + GetParamNo(1, name, &charge, &form); + if (form==1) + strcpy(rename, name); + else + RenameSpec(rename, name, charge); + for(j=0; j0.0) + fprintf(ccode, "initndir[%d]=1;\n", dyn); + else + fprintf(ccode, "initndir[%d]=-1;\n", dyn); + fprintf(ccode, "inithmax[%d]=%e;\n", dyn, fabs(temp)); + } /* if */ + } /* else */ + + temp=GetSpecConst(name, charge, "Bfxmax"); + BfErrorCode= GetError(); + if (BfErrorCode==NotFound) { + fprintf(ccode, "initxupp[%d]=%e;\n", dyn, 1.0E3); + } else { + if (BfErrorCode==NoError) { + fprintf(ccode, "initxupp[%d]=%e;\n", dyn, temp); + } /* if */ + } /* else */ + + temp=GetSpecConst(name, charge, "Bfxmin"); + BfErrorCode= GetError(); + if (BfErrorCode==NotFound) { + fprintf(ccode, "initxlow[%d]=%e;\n", dyn, 0.0); + } else { + if (BfErrorCode==NoError) { + fprintf(ccode, "initxlow[%d]=%e;\n", dyn, temp); + } /* if */ + } /* else */ + + temp=GetSpecConst(name, charge, "Bfpref"); + BfErrorCode= GetError(); + if (BfErrorCode==NotFound) { + fprintf(ccode, "initpref[%d]=%e;\n", dyn, 0.1); + } else { + if (BfErrorCode==NoError) { + fprintf(ccode, "initpref[%d]=%e;\n", dyn, temp); + } /* if */ + } /* else */ + + + } /* if */ + } /* for i */ + + for(i=1; i<=NumOfParameter(); i++) { + GetParamNo(i, name, &charge, &form); + if (form==1) { + GetInitParam(name, &temp); + fprintf(ccode, "xx[n%d]=%e;\n", i, temp); + temp=GetDirectForParam(name); + if (temp>0.0) + fprintf(ccode, "initndir[n%d]=1;\n", i); + else + fprintf(ccode, "initndir[n%d]=-1;\n", i); + GetDeltaParam(name, &temp); + fprintf(ccode, "inithmax[n%d]=%e;\n", i, fabs(temp)); + GetLowHighPrefParam(name, &temp, &temp1, &temp2); + fprintf(ccode, "initxlow[n%d]=%e;\n", i, temp); + fprintf(ccode, "initxupp[n%d]=%e;\n", i, temp1); + if ((temp2>1.0) && (temp2<0.0)) + fprintf(ccode, "KnCont: Pref. for %s must between 0 and 1.\n", name); + else + fprintf(ccode, "initpref[n%d]=%e;\n", i, temp2); + } /* if */ + else { + GetInitConc(name, charge, &temp); + fprintf(ccode, "xx[n%d]=%e;\n", i, temp); + temp=GetDirectForConc(name, charge); + if (temp>0.0) + fprintf(ccode, "initndir[n%d]=1;\n", i); + else + fprintf(ccode, "initndir[n%d]=-1;\n", i); + GetDeltaConc(name, charge, &temp); + fprintf(ccode, "inithmax[n%d]=%e;\n", i, fabs(temp)); + GetLowHighPrefConc(name, charge, &temp, &temp1, &temp2); + fprintf(ccode, "initxlow[n%d]=%e;\n", i, temp); + fprintf(ccode, "initxupp[n%d]=%e;\n", i, temp1); + if ((temp2>1.0) && (temp2<0.0)) + fprintf(ccode, "KnCont: Pref. for %s(%d) must between 0 and 1.\n", + name, (int)charge); + else + fprintf(ccode, "initpref[n%d]=%e;\n", i, temp2); + } /* else */ + } /* for i */ + fprintf(ccode, "} /* derpinit */n\n"); + /* End of printing derpinit */ + + fprintf(ccode, "void hf_dalfa(int bj_,int tp_, double xx_, double **gg_)\n"); + fprintf(ccode, "{\n"); + fprintf(ccode, "} /* hf_dalfa */\n\n"); + /* End of printing hf_dalfa */ + + /*Printing hopfinit */ + fprintf(ccode, "void hopfinit(void)\n{\n"); + fprintf(ccode, "} /* hopfinit */\n\n"); + /* End of printing hopfinit */ + + break; + case 2: + /*Printing hf_dalfa */ + + fprintf(ccode, "void sp_dalfa(int bj_,double xx_, double **gg_)\n"); + fprintf(ccode, "{\n"); + fprintf(ccode, "} /* sp_dalfa */\n\n"); + /* End of printing sp_dalfa */ + + /* Printing derpinit */ + fprintf(ccode, "void derpinit(void)\n{\n"); + fprintf(ccode, "} /* derpinit */\n\n"); + /* End of printing derpinit */ + + fprintf(ccode, "void hf_dalfa(int bj_,int tp_, double xx_, double **gg_: glnpbynp)\n"); + fprintf(ccode, "{\n"); + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if ((IsSpecInConstraint(name, charge)==0) && + (IsSpecParam(name, charge)!=1)) { + RenameSpec(rename, name, charge); + fprintf(ccode, "%s=xx_[%d];\n", rename, dyn); + dyn++; + } /* if */ + } /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(ccode, "%s=xx_[%d];\n", name, i+NoOfSpec()-NumOfConstraint()); + } /* for i */ + + fprintf(ccode, "if (tp_==1) {\n"); + for(i=1; i<=NumbOfParams; i++) { + GetParamNo(i, name, &charge, &form); + if (form==2) + RenameSpec(rename, name, charge); + else + strcpy(rename, name); + fprintf(ccode, "%s=xx_[n%d];\n", rename, i); + } /* for i */ + fprintf(ccode, "if (bj_==1) {\n"); + GetParamNo(1, name, &charge, &form); + if (form==2) + RenameSpec(rename, name, charge); + else + strcpy(rename, name); + for(j=0; j=1; i--) { + GetParamNo(i, name, &charge, &form); + if (form==2) + RenameSpec(rename, name, charge); + else + strcpy(rename, name); + fprintf(ccode, "%s=xx_[n%d];\n", rename, NumbOfParams+1-i); + } /* for i */ + fprintf(ccode, "if (bj_==1) {\n"); + GetParamNo(2, name, &charge, &form); + if (form==2) + RenameSpec(rename, name, charge); + else + strcpy(rename, name); + for(j=0; j0.0) + fprintf(ccode, "initndir[%d]=1;\n", dyn); + else + fprintf(ccode, "initndir[%d]=-1;\n", dyn); + fprintf(ccode, "inithmax[%d]=%e;\n", dyn, fabs(temp)); + } /* if */ + } /* else */ + + temp=GetSpecConst(name, charge, "Bfxmax"); + BfErrorCode= GetError(); + if (BfErrorCode==NotFound) { + fprintf(ccode, "initxupp[%d]=%e;\n", dyn, 1.0E3); + } else { + if (BfErrorCode==NoError) { + fprintf(ccode, "initxupp[%d]=%e;\n", dyn, temp); + } /* if */ + } /* else */ + + temp=GetSpecConst(name, charge, "Bfxmin"); + BfErrorCode= GetError(); + if (BfErrorCode==NotFound) { + fprintf(ccode, "initxlow[%d]=%e;\n", dyn, 0.0); + } else { + if (BfErrorCode==NoError) { + fprintf(ccode, "initxlow[%d]=%e;\n", dyn, temp); + } /* if */ + } /* else */ + + temp=GetSpecConst(name, charge, "Bfpref"); + BfErrorCode= GetError(); + if (BfErrorCode==NotFound) { + fprintf(ccode, "initpref[%d]=%e;\n", dyn, 0.1); + } else { + if (BfErrorCode==NoError) { + fprintf(ccode, "initpref[%d]=%e;\n", dyn, temp); + } /* if */ + } /* else */ + + } /* if */ + } /* for i */ + for(i=1; i<=NumOfParameter(); i++) { + GetParamNo(i, name, &charge, &form); + if (form==1) { + GetInitParam(name, &temp); + fprintf(ccode, "xx[n%d]=%e;\n", i, temp); + temp=GetDirectForParam(name); + if (temp>0.0) + fprintf(ccode, "initndir[n%d]=1;\n", i); + else + fprintf(ccode, "initndir[n%d]=-1;\n", i); + GetDeltaParam(name, &temp); + fprintf(ccode, "inithmax[n%d]=%e;\n", i, fabs(temp)); + GetLowHighPrefParam(name, &temp, &temp1, &temp2); + fprintf(ccode, "initxlow[n%d]=%e;\n", i, temp); + fprintf(ccode, "initxupp[n%d]=%e;\n", i, temp1); + if ((temp2>1.0) && (temp2<0.0)) + fprintf(ccode, "KnCont: Pref. for %s must between 0 and 1.\n", name); + else + fprintf(ccode, "initpref[n%d]=%e;\n", i, temp2); + } /* if */ + else { + GetInitConc(name, charge, &temp); + fprintf(ccode, "xx[n%d]=%e;\n", i, temp); + temp=GetDirectForConc(name, charge); + if (temp>0.0) + fprintf(ccode, "initndir[n%d]=1;\n", i); + else + fprintf(ccode, "initndir[n%d]=-1;\n", i); + GetDeltaConc(name, charge, &temp); + fprintf(ccode, "inithmax[n%d]=%e;\n", i, fabs(temp)); + GetLowHighPrefConc(name, charge, &temp, &temp1, &temp2); + fprintf(ccode, "initxlow[n%d]=%e;\n", i, temp); + fprintf(ccode, "initxupp[n%d]=%e;\n", i, temp1); + if ((temp2>1.0) && (temp2<0.0)) + fprintf(ccode, "KnCont: Pref. for %s(%d) must between 0 and 1.\n", + name, (int)charge); + else + fprintf(ccode, "initpref[n%d]=%e;\n", i, temp2); + } /* else */ + } /* for i */ + fprintf(ccode, "} /* hopfinit */\n\n"); + + /* End of printing hopfinit */ + + break; + } /* switch NumbOfParams */ + + /* Printing detnumparam */ + + fprintf(ccode, "void detnumparam(void)\n"); + fprintf(ccode, "{\n"); + fprintf(ccode, " numparam=%d;\n", NumbOfParams); + fprintf(ccode, "} /* detnumparam */\n\n"); + /* End of printing detnumparam */ + + + StringFree(name); + StringFree(rename); +} /* KnCC */ + diff --git a/old_src/knquench.c b/old_src/knquench.c new file mode 100644 index 0000000..3c8b78b --- /dev/null +++ b/old_src/knquench.c @@ -0,0 +1,394 @@ +/************************************************************************* + KNQuench - a code generator for kc. + + CopyWrong 1993-1995 by + Kenneth Geisshirt (kneth@fatou.ruc.dk) + Department of Life Sciences and Chemistry + Roskilde University + P.O. Box 260 + 4000 Roskilde + Denmark + + See kc.tex for details + + Last updated: 15 May 1995 by KN +*************************************************************************/ + +#include +#include +#include +#include "config.h" +#include "symbmath.h" +#include "tableman.h" +#include "misc.h" +#include "codegen.h" +#include "eigen.h" +#include "complex.h" +#include "matrix.h" + +void KnQuench(void) { + + double charge, temp; + char *name, *rename; + Tree tmp; + int i, j, l, k, no_eval=1, ref; + int num_of_spec, max_iter,num_of_reac; + double angle,eps, sum_left, sum_right, sumfw, sumrv,sumfw_im,sumrv_im; + double qd, fd; + double *am,*ph,*fu,*qu; + double **jac_num; + double **QP, **INVQP; + double *stconc, *reacfw_, *reacrv_, *flowfw, *flowrv; + double **reacfwds_, **reacrvds_; + double leftsc,rightsc; + Complex z_,*values, **vectors; + + name=StringAlloc(); + rename=StringAlloc(); + + num_of_spec=NoOfSpec()+NumOfDynVar()-NumOfConstraint(); + num_of_reac= NoOfReact(); + + jac_num= MatrixAlloc(num_of_spec); + QP= MatrixAlloc(num_of_spec); + INVQP= MatrixAlloc(num_of_spec); + am= VectorAlloc(num_of_spec); + ph= VectorAlloc(num_of_spec); + fu= VectorAlloc(num_of_spec); + qu= VectorAlloc(num_of_spec); + reacfw_= VectorAlloc(num_of_reac); + reacrv_= VectorAlloc(num_of_reac); + flowfw= VectorAlloc(num_of_reac); + flowrv= VectorAlloc(num_of_reac); + stconc= VectorAlloc(num_of_spec); + values=ComplexVectorAlloc(num_of_spec); + vectors=ComplexMatrixAlloc(num_of_spec); + + if (num_of_spec>num_of_reac) { + reacfwds_= MatrixAlloc(num_of_spec); + reacrvds_= MatrixAlloc(num_of_spec); + } else { + reacfwds_= MatrixAlloc(num_of_reac); + reacrvds_= MatrixAlloc(num_of_reac); + } + + InitCodeGenVar(num_of_spec, NumOfConstraint(),NoOfReact()); + GenerateRateExpr(); + GenerateJacobi(); + GenerateDiffReac(); + + temp=GetConstant("epsa"); + if (GetError()==NoError) + eps=temp; + else + temp=1.0e-18; + temp=GetConstant("maxiter"); + if (GetError()==NoError) + max_iter=(int)temp; + else + max_iter=30; + + temp=GetConstant("ref"); + if (GetError()==NoError) + ref=(int)temp; + else + ref=1; + + for(i=0; inum_of_reac) { + MatrixFree(num_of_spec,reacfwds_); + MatrixFree(num_of_spec,reacrvds_); + } else { + MatrixFree(num_of_reac,reacfwds_); + MatrixFree(num_of_reac,reacrvds_); + } +} /* KnQuench */ diff --git a/old_src/knquench.h b/old_src/knquench.h new file mode 100644 index 0000000..54c4539 --- /dev/null +++ b/old_src/knquench.h @@ -0,0 +1,11 @@ +/* KnQuench - a code generator for kc. + CopyWrong Kenneth Geisshirt 1993 + + See kc.tex for details. +*/ + +#ifndef _KNQUENCH_ +#define _KNQUENCH_ + +extern void KnQuench(void); +#endif diff --git a/old_src/kpsolver.c b/old_src/kpsolver.c new file mode 100644 index 0000000..d4d69b4 --- /dev/null +++ b/old_src/kpsolver.c @@ -0,0 +1,671 @@ +/*************************************************************************** + The source file contains the driver for solving ODEs. + + CopyWrong 1994-1995 by + Kenneth Geisshirt (kneth@fatou.ruc.dk) + Department of Life Sciences and Chemistry + Roskilde University + P.O. Box 260 + 4000 Roskilde + Denmark + + and + Keld Nielsen (kn@kiku.dk) + Department of Theoretical Chemistry + H.C. Orsted Institute + Universitetsparken 5 + 2100 Copenhagen + Denmark + + References: + [1] W.H. Press, et al. Numerical Recipes in C, 2. edition. + Cambridge University Press, 1992. + [2] D.A. Calahan. (1968). Proc. IEEE, April 1968, p. 744. + [3] P. Kaps, and P. Rentrop. (1979). Numer. Math, 33, pp. 55-68. + [4] K. Geisshirt. Chemical Waves in Reaction-Diffusion Systems: A Numerical + Study. (M.Sc. thesis, University of Copenhagen), 1994. + [5] M. Kubicek, and M. Marek, Computational Methods In Bifucation Theory + And Dissipative Structures, Springer-Verlag, New York, 1983. + [6] J.R. Cash, and A.H. Karp. (1990). ACM Trans. Math. Softw. 16, + pp. 201-222. + [7] P. Kaps, S.W.H. Poon, and T.D. Bui. (1985). Computing. 34, pp. 17-40. + [8] P. Deuflhard, G. Bader, and U. Nowak. (1981). pp. 38-55. + In K.H. Ebert, P. Deuflhard, and W. Jager (eds.). Modelling of Chemical + Reaction Systems. Springer Series in Chemical Physics, Vol. 18. + Springer-Verlag, Berlin, 1981. + [9] E. Hairer, and G. Wanner. Solving Ordinary Differential Equations II. + Springer Series In Computational Mathematics, Vol. 14. Springer-Verlag, + Berlin, 1991. + [10] D. Kincaid, and W. Cheney. Numerical Analysis. Brooks/Cole, 1991. + + Last updated: 5 June 1995 by KN +****************************************************************************/ + +#define VERSION_ "1.05" + +#include +#include +#include +#include + +/*************************************************************************** + The solvers for ODEs and the service routines are imported below. +****************************************************************************/ + +#include "odesolv.h" +#include "odeserv.h" + + +/*************************************************************************** + The matrix manipulating routines like linear equation solvers are all + implemented in a small library. It is imported below. + + Routines for integrating functions are also imported below. +****************************************************************************/ + +#include "matrix.h" + +/*************************************************************************** + The program has a number of global variables. Each variable has an + underscore as the last character in order to eliminate conflicts with + names in the model. + + time_ The independent variable of the ODEs + stime_ Initial value for the independent variable. Default: 0 + etime_ Final value for the independent variable. Default: 200 + dtime_ Output at equidistant points. Also functioning as the largest + possible stepsize. Default: 2.0 + htime_ Stepsize + epsr_ Relative error tolerance. Default: 1.0E-5 + epsa_ Absolute error tolerance. Default: 1.0E-15 + epsmin_ Relative machine precision. Default: 1.0E-16 + timenew_ New value of the independent variable before a new step of + integration is accepted. + htimenew_ New value of the stepsize before a new step of integration is + accepted. + errlim_ The ratio between the estimate of the (scaled) local truncation + error and the relative tolenrance. + If errlim_>1.0 the steplength (hstep_) is rejected otherwise + the step of integration is accepted. + thtime_ The value of the independent variable for the next output. + step_adjustment_factor + Safety factor in the calculation of a new stepsize. Default: 0.9 + order_of_method + The order of the integration method + steplimit_increase + Upper bound for the ratio of two consecutive steps. Default: 1.5 + steplimit_decrease + Lower bound for the ratio of two consecutive steps. Default: 0.5 + step_increase_factor == -1/order_of_method. + Used in the calculation of the new steplength. + errcon_ Smallest value of errlim_, [1] + htimemin_ The minimal allowed stepsize. Default: Relative machine + precision. + + mainmode_ 1==ODEs, 2==PDEs, 3==compute LCEs. Default: 1 + solver_ Method of integration. Default: 1 + prnmode_ Mode of output. 0: Equidistant and extrema points. + 1: Only equidistant points. + 2: Quantum chemistry mode (don't use). + Default: 0 + scaling_ Method of scaling. 0: Strict relative error [8], + 1: Scaling device in error estimate due + to Deuflhard et al., [8]. + debug_ Mode of debug: 0: No output during numerical integration. + 1: Time, steplength and values of the variables + are printed. + 2: Different control values are printed. + Extension of mode 1. + 3: Initial values of different control values are + printed. + Default: 0 + finish_ If the user interupt the program, finish_ will be set to + 1, and the program will be terminated nicely. See also the + signal handler. + pert_ Keeps track of pertubation of the differential equations. + ptime_ Time for a perturbation. + dptime_ Time between perturbations. + no_pert Number of perturbations done so far. + next_pert Time for next perturbation. + outfile Handler to output file. + i Simple counter. + datafilename_Name of output file. + + equa Number of differential equations. + ns_ = equa-1 Number of dependent variables in a nonautonomous + differential equations. + xnew_ New values of the dependent variables. + xerr_ Estimate of the unscaled local truncation errors for the + dependent variables. + begin_print Time for first print out. + species_ A table with the names of the independent variables. + + + The file model.c contains the C-code that depends on a specific model. + It is generated by kc, see [4]. +*****************************************************************************/ + +static double time_, stime_, etime_, dtime_, htime_, epsr_, epsa_; +static double epsmin_, timenew_, htimenew_, errlim_, thtime_, ptime_; +static double step_adjustment_factor, order_of_method, steplimit_increase; +static double steplimit_decrease, step_increase_factor, errcon_, htimemin_; +static int mainmode_, solver_, prnmode_, scaling_, pert_=1, i; +static double dptime_, next_pert, no_pert; +static double begin_print; +static FILE *outfile; +static char datafilename_[35]; +static int iter_, debug_=1, finish_=0; +static int steprejection_=0; /* Number of step rejections */ +static double cmax_, cmin_; +int nospecieserr_; /* Number of variables used in the estimate + of local error */ + +#include "model.c" + +static const int ns_ = equa-1; +static double xnew_[equa], xerr_[equa]; +static double fx_[equa], temp_[equa], xdt_[equa]; + +/**************************************************************************** + The routine UserInterrupt catch the interrupt signal from the operating + system. This signal is sent when the user wants to abort the program + before normal termination. The feature ensure that the buffers are flushed, + and the termination in general is done "nicely". The signal handler is + very simple - the actual work is done by the main program. +*****************************************************************************/ + +void UserInterrupt(int dummy) { + + finish_=1; +} /* UserInterrupt */ + + +/*************************************************************************** + PrintDebug is the debugging routine of the program. It prints the + information specified by the variable debug_. The information is printed + on the standard output. +****************************************************************************/ + +void PrintDebug(int flag_, double t1_, double ht1_, double *x1_, double t2_, + double ht2_, double *x2_) { + + int i; + + switch (flag_) { + case 0: + /* do nothing */ + break; + case 1: + printf("\33HTime: %e Steplength: %e\33K\n\33K\n", t2_, ht2_); + for(i=0; i0.0) + nsg_[i]=1; + else + nsg_[i]=0; + } /* for i */ + + if (first_time) { + first_time=0; + for(i=0; iepsa_) + flag_++; + } /* if */ + if ((osg_[i]!=nsg_[i]) && (nsg_[i]==1)) { + osg_[i]=nsg_[i]; + if (fabs(x_[i]-xmax_[i])>epsa_) + flag_++; + } /* if */ + } /* for i */ + return flag_; +} /* ChangeSignVectors */ + + +/*************************************************************************** + Main initialises the system, and it is also the driver routine for the + numerical schemes implemented. + + The idea is that each solver takes one time step, and main contains a + loop going from time=initial time to termination time. The step length + controller is implemented as part of main. +****************************************************************************/ + +void main(void) { + + double xmin_[equa], xmax_[equa], hlp_; + time_t timer_; /* time and date */ + int i, j, dyn_, csv_, prndt_; + int nsg_[equa], osg_[equa]; + + + printf("KKsolver v%s, CopyWrong 1994-1995 by Keld Nielsen and Kenneth Geisshirt\n", VERSION_); + + /* Find time and date */ + timer_=time(&timer_); + + /* Set up signal handler */ + (void) signal(SIGINT, &UserInterrupt); + + /* Allocate the jacobian matrix */ + jacobi_matx=MatrixAlloc(equa); + + /* Initialization of the model dependent variables. */ + InitValues(); + + /* Initialize parameters for various printing modes */ + switch (prnmode_) { + case 0: + for(i=0; ietime_) + kcerror("stime > etime"); + + /* Program aborted: If initial time is less than the zero */ + if (time_<0.0) + kcerror("stime < 0.0"); + + /* Program aborted: If initial stepsize is less than the zero */ + if (htime_<0.0) + kcerror("htime < 0.0"); + + /* Program aborted: If requested output at eqvidistant points + is not resonable */ + if (dtime_<0.0) + kcerror("dtime < 0.0"); + + /* Smallest absoulte error not less than relative machine precision */ + if (epsa_=0.5*dtime_) + htime_=0.5*dtime_; + + /* Opening output file */ + outfile=fopen(datafilename_, "w"); + fprintf(outfile, "# Output from kksolver v%s, %s", VERSION_, + ctime(&timer_)); + fprintf(outfile, "# CopyWrong 1994-1995 by Keld Nielsen and Kenneth Geisshirt\n"); + dyn_=1; + for(i=0; i=begin_print) + PrintState(nospecieserr_, prnmode_, 0, time_, x_, outfile, do_print); + + if (debug_==3) + PrintDebug(debug_, time_, htime_, x_, time_, htime_, x_); + + /* Main part of the integration algorithm */ + while ((time_etime_) + thtime_=etime_; + + if (debug_==2) + PrintDebug(debug_, time_, htime_, x_, time_+htime_, htimenew_, xnew_); + + if (errlim_>1.0) { /* The new stepsize is not accepted if the + local error estimate is larger than the + relative error tolerance */ + htime_=htimenew_; + if (steprejection_!=2) { + steprejection_++; + } else { /* If the new stepsize has been rejected more + than two times the new stepsize is drastical + reduced; h_new= h_old/10. + Method suggested by Hairer and Wanner [9] */ + steprejection_=0; + htime_= htimenew_/10.0; + } /* else */ + } else { /* The new stepsize is accepted if the local error + estimate is less or equal to the relative error + tolerance */ + timenew_=time_+htime_; + steprejection_=0; + + if (timenew_=begin_print)) + PrintState(nospecieserr_, prnmode_, 2, time_, x_, outfile, + do_print); + if (prndt_) + prndt_=0; + } /* if */ + time_=timenew_; + htime_=htimenew_; + for(i=0; i=begin_print) + PrintState(nospecieserr_, prnmode_, 1, time_, x_, outfile, + do_print); + if (debug_==1) + PrintDebug(debug_, timenew_, htimenew_, xnew_, time_, htime_, x_); + } else { /* The new time exceed the time for the + next output. The differential equations + are integrated from (t) to (t+dt), and + the solution at t+dt is printed. The + integration begin again from (t+h, xnew_) */ + hlp_=thtime_-time_; + switch(solver_) { + case 1: /* Calahan */ + CalahanOneStep(equa, hlp_, x_, xdt_, &reac, &jacobi); + break; + case 2: /* GRK4T */ + GRK4T(equa, hlp_, x_, xdt_, xerr_, &reac, &jacobi); + break; + case 3: /* RKFNC */ + RKFNC(equa, hlp_, x_, xdt_, xerr_, &reac); + break; + case 4: /* RK4 */ + RK4OneStep(equa, hlp_, x_, xdt_, &reac); + break; + case 5: /* GRK4TTime */ + GRK4TTime(equa, ns_, time_, hlp_, x_, xdt_, xerr_, &reac, &jacobi); + break; + case 6: /* RKFNCTime */ + RKFNCTime(equa, ns_, time_, hlp_, x_, xdt_, xerr_, &reac); + break; + } /* switch (solver_) */ + + if (prnmode_==0) { /* Output: The extrema values */ + csv_=ChangeSignVectors(nospecieserr_, x_, xnew_, xmax_, xmin_, + osg_, nsg_); + prndt_=1; + } + if (debug_==1) + PrintDebug(debug_, time_, htime_, x_, thtime_, htime_, xdt_); + time_=thtime_; + htime_=htimenew_; + thtime_+=dtime_; + for(i=0; i=begin_print) + PrintState(nospecieserr_,prnmode_,1,time_,x_,outfile,do_print); + } /* else */ + } /* else */ + } /* ptime_>timenew_ */ + else { + if (timenew_>ptime_) { + PrintState(nospecieserr_, prnmode_, 1, time_, x_, outfile, do_print); + hlp_=thtime_-time_; + switch(solver_) { + case 1: /* Calahan */ + CalahanOneStep(equa, hlp_, x_, xdt_, &reac, &jacobi); + break; + case 2: /* GRK4T */ + GRK4T(equa, hlp_, x_, xdt_, xerr_, &reac, &jacobi); + break; + case 3: /* RKFNC */ + RKFNC(equa, hlp_, x_, xdt_, xerr_, &reac); + break; + case 4: /* RK4 */ + RK4OneStep(equa, hlp_, x_, xdt_, &reac); + break; + case 5: /* GRK4TTime */ + GRK4TTime(equa, ns_, time_, hlp_, x_, xdt_, xerr_, &reac, &jacobi); + break; + case 6: /* RKFNCTime */ + RKFNCTime(equa, ns_, time_, hlp_, x_, xdt_, xerr_, &reac); + break; + } /* switch (solver_) */ + time_=thtime_; + htime_=htimenew_; + thtime_+=dtime_; + for(i=0; i=begin_print) + PrintState(nospecieserr_,prnmode_,1,time_,x_,outfile,do_print); + for(i=0; i=begin_print) + PrintState(nospecieserr_,prnmode_,1,time_,x_,outfile,do_print); + ptime_ += etime_+1.0; + } else { + if (timenew_=ptime_) { + time_=timenew_; + htime_=htimenew_; + for(i=0; i=begin_print) + PrintState(nospecieserr_, prnmode_, 1, time_, x_, outfile, do_print); + for(i=0; i=begin_print) + PrintState(nospecieserr_,prnmode_,1,time_,x_,outfile,do_print); + ptime_ += etime_+1.0; + } + } + } + + } /* errlim_ <= 1.0 */ + + } /* while (time_ +#include +#include + + +double Argu(double g, double h) { +/* return (360.0/2.0/3.14159265359*atan(h,g)) */ + return (57.2957795131*atan2(h,g)); +} /* Argu */ + +double Radius(double a, double b) { + return (sqrt(a*a+b*b)); +} /* Radius */ + +void compamppha(int n, double P[4][4], double amp[4], double phase[4]) { + + int i; + + for(i=0;i +#include +#include +#include + +void StocCode(FILE *code) { + + char *name, *rename; + time_t timer; + double volume; + int i, j, react_no, finished, dyn; + Tree temp_tree; + double coeff, charge, temp; + int fac, sfac; + double rate_const[2*MaxReact]; + + name=(char *)malloc(sizeof(char)); + rename=(char *)malloc(sizeof(char)); + + timer=time(&timer); + fprintf(code, "/******************************************************\n"); + fprintf(code, " Warning: This file was generated by kc v%s\n", VERSION); + fprintf(code, " CopyWrong by Kenneth Geisshirt (kneth@osc.kiku.dk)\n"); + fprintf(code, " %s*/\n", ctime(&timer)); + fprintf(code, "*******************************************************/\n"); + + volume=GetConstant("vol"); + if (GetError()==NotFound) + fprintf(stderr, "STOC: Volume (vol) is not speficied.\n"); + + dyn=0; + for(i=1; i<=NoOfReact(); i++) { + react_no=GetReactNo(i-1); + switch (GetReactKind(react_no)) { + case uni: + if (GetRateKind(react_no, uni, 1)==1) { + dyn++; + temp_tree=TreeCreate(); + GetRateConst(react_no, uni, 1, temp_tree); + temp=TreeEval(temp_tree); + if (TreeGetError()==NoEval) + fprintf(stderr, "STOC: Unable to evaluate rate constant for reaction %d\n", react_no); + TreeKill(temp_tree); + rate_const[2*(i-1)]=pow(volume, SumCoeff(1))*temp; + finished=GetFirstSpecA(react_no, name, &charge, &coeff, 0); + while (finished==1) { + constraint=IsSpecInConstraint(name, charge); + if (constraint==0) + rate_const[2*(i-1)]/=(double)Fact((int)coeff); + finished=GetNextSpecA(name, &charge, &coeff, 0); + } /* while */ + } /* if */ + break; + case bi: + if (GetRateKind(react_no, bi, 1)==1) { + dyn++; + temp_tree=TreeCreate(); + GetRateConst(react_no, bi, 1, temp_tree); + temp=TreeEval(temp_tree); + if (TreeGetError()==NoEval) + fprintf(stderr, "STOC: Unable to evaluate rate constant for reaction %d\n", react_no); + TreeKill(temp_tree); + rate_const[2*(i-1)]=pow(volume, SumCoeff(1))*temp; + finished=GetFirstSpecA(react_no, name, &charge, &coeff, 0); + while (finished==1) { + constraint=IsSpecInConstraint(name, charge); + if (constraint==0) + rate_const[2*(i-1)]/=(double)Fact((int)coeff); + finished=GetNextSpecA(name, &charge, &coeff, 0); + } /* while */ + } /* if */ + if (GetRateKind(react_no, bi, 2)==1) { + dyn++; + temp_tree=TreeCreate(); + GetRateConst(react_no, bi, 2, temp_tree); + temp=TreeEval(temp_tree); + if (TreeGetError()==NoEval) + fprintf(stderr, "STOC: Unable to evaluate rate constant for reaction %d\n", react_no); + rate_const[2*(i-1)+1]=pow(volume, SumCoeff(2))*temp; + finished=GetFirstSpecA(react_no, name, &charge, &coeff, 1); + while (finished==1) { + constraint=IsSpecInConstraint(name, charge); + if (constraint==0) + rate_const[2*(i-1)+1].value/=(double)Fact((int)coeff); + finished=GetNextSpecA(name, &charge, &coeff, 1); + } /* while */ + } /* if */ + break; + case equi: + fprintf(stderr, "STOC: Cannot handle equilibriums.\n"); + break; + } /* switch */ + } /* for i */ + + fprintf(code, "double A[%d];\n", dyn); + + fprintf(code, "void CalcA(void) {\n"); + dyn=-1; + for(i=1; i<=NoOfReact(); i++) { + react_no=GetReactNo(i-1); + switch (GetReactKind(react_no)) { + case uni: + if (GetRateKind(react_no, uni, 1)==1) { + dyn++; + fprintf(code, "A[%d]=%e", dyn, rate_const[2*(i-1)]); + finished=GetFirstSpecA(react_no, name, &charge, &coeff, 0); + while (finished==1) { + RenameSpec(rename, name, charge); + constraint=IsSpecInConstraint(name, charge); + if (constraint==0) { + for(j=1; j<=(int)coeff; j++) + fprintf(code, "*(%s-%d)", rename, j-1); + fprintf(code, "/%e", (double)Fact((int)coeff)); + } + finished=GetNextSpecA(name, &charge, &coeff, 0); + } /* while */ + } /* if */ + break; + case bi: + if (GetRateKind(react_no, bi, 1)==1) { + dyn++; + fprintf(code, "A[%d]=%e", dyn, rate_const[2*(i-1)]); + finished=GetFirstSpecA(react_no, name, &charge, &coeff, 0); + while (finished==1) { + RenameSpec(rename, name, charge); + constraint=IsSpecInConstraint(name, charge); + if (constraint==0) { + for(j=1; j<=(int)coeff; j++) + fprintf(code, "*(%s-%d)", rename, j-1); + fprintf(code, "/%e", (double)Fact((int)coeff)); + } + finished=GetNextSpecA(name, &charge, &coeff, 0); + } /* while */ + } /* if */ + if (GetRateKind(react_no, bi, 2)==1) { + dyn++; + fprintf(code, "A[%d]=%e", dyn, rate_const[2*(i-1)+1]); + finished=GetFirstSpecA(react_no, name, &charge, &coeff, 1); + while (finished==1) { + RenameSpec(rename, name, charge); + constraint=IsSpecInConstraint(name, charge); + if (constraint==0) { + for(j=1; j<=(int)coeff; j++) + fprintf(code, "*(%s-%d)", rename, j-1); + fprintf(code, "/%e", (double)Fact((int)coeff)); + } + finished=GetNextSpecA(name, &charge, &coeff, 1); + } /* while */ + } /* if */ + break; + case equi: + fprintf(stderr, "STOC: Cannot handle equilibriums.\n"); + break; + } /* switch */ + } /* for i */ + + + diff --git a/old_src/stoc.h b/old_src/stoc.h new file mode 100644 index 0000000..555ede7 --- /dev/null +++ b/old_src/stoc.h @@ -0,0 +1,24 @@ +/************************************************************************ + Stoc - code generator to kc. + + The code generator is viewing reactions as a stocastic + process, see J. Comp. Phys., vol 22, pp. 403-434 (1976). + + CopyWrong 1993, 1994 by + Kenneth Geisshirt (kneth@osc.kiku.dk) + Department of Theoretical Chemistry + H.C. Orsted Institute + Universitetsparken 5 + 2100 Copenhagen + Denmark + + See kc.tex for details. + + Last updated: 4 April 1994 +*************************************************************************/ + +#ifndef _CODE_STOC_ +#define _CODE_STOC_ + +extern void StocCode(FILE *); +#endif diff --git a/old_src/symbcont.c b/old_src/symbcont.c new file mode 100644 index 0000000..50429f0 --- /dev/null +++ b/old_src/symbcont.c @@ -0,0 +1,244 @@ +/* SymbCont - a code generator for kc and CONT. + This is a full operating generator. + CopyWrong by Kenneth Geisshirt, 1992, 1993 + + See kc.tex for details +*/ + +#include +#include +#include +#include "config.h" +#include "symbmath.h" +#include "tableman.h" +#include "codegen.h" + +void SymbCont(FILE *code) { + + double charge, temp, coeff; + char *name, *rename; + time_t timer; + Tree v[ExprSize+SymSize], con[ConstrainSize], r[ExprSize+SymSize]; + Tree jacobi[ExprSize+SymSize+MaxParameter][ExprSize+SymSize+MaxParameter]; + Tree v_temp, tmp, temp_tree, tmp2; + int i, j, k, react_no, finished, constraint, dyn, dyn2, dyn3, form; + + name=malloc(sizeof(char)); + rename=malloc(sizeof(char)); + timer=time(&timer); + + fprintf(code, " SUBROUTINE MODEL(ndim, nvar, n, t, yy, f, g, h)\n"); + fprintf(code, "C %s", ctime(&timer)); + fprintf(code, " IMPLICIT REAL*8(a-h,o-z)\n"); + fprintf(code, " DIMENSION yy(ndim), f(ndim), g(ndim, nvar), h(ndim, nvar, ndim)\n"); + i=NoOfSpec()+NumOfDynVar()-NumOfConstraint(); /* abuse of i */ + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + RenameSpec(rename, name, charge); + fprintf(code, " REAL*8 %s\n", rename); + }; /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(code, " REAL*8 %s\n", name); + }; /* for i */ + for(i=1; i<=(NoOfReact()+NumOfExpr()); i++) { + fprintf(code, " REAL*8 r%d\n", i-1); + }; /* for i */ + fprintf(code, " COMMOM /fixp/ par(20)\n"); + fprintf(code, " COMMOM /varp/ alpha, beta, arg, per\n"); + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + RenameSpec(rename, name, charge); + constraint=IsSpecInConstraint(name, charge); + if (constraint==0) { + fprintf(code, " %s=yy(%d)\n", rename, dyn); + dyn++; + }; /* if */ + }; /* for i*/ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(code, " %s=par(%d)\n", name, i); + }; /* for i */ + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + RenameSpec(rename, name, charge); + constraint=IsSpecInConstraint(name, charge); + if (constraint>0) { + fprintf(code, " %s=", rename); + TreePrint(con[constraint-1], 1, code); + fprintf(code, "\n"); + }; /* if */ + }; /* for i */ + dyn=0; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) { + fprintf(code, " f(%d)=", dyn+1); + TreePrint(v[dyn], 1, code); + dyn++; + }; /* if */ + }; /* for i */ + fprintf(code, " IF (n.EQ.ndim) RETURN\n"); + dyn=0; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) { + dyn++; + dyn2=1; + for(j=1; j<=NoOfSpec(); j++) { + tmp=TreeCreate(); + TreeCpy(tmp, v[dyn-1]); + GetSpecNo(j, name, &charge); + RenameSpec(rename, name, charge); + if (IsSpecInConstraint(name, charge)==0) { + temp=TreeEval(jacobi[dyn-1][dyn2-1]); + if ((TreeGetError()==NoEval) || (temp!=0.0)) { + fprintf(code, " g(%d, %d)=", dyn, dyn2); + TreePrint(tmp, 1, code); + fprintf(code, "\n"); + } /* if */ else + fprintf(code, " g(%d, %d)=%e\n", dyn, dyn2, temp); + } + } + for(j=1; j<=NumOfParameter(); j++) { + tmp=TreeCreate(); + TreeCpy(tmp, v[dyn-1]); + GetParamNo(j, name, &charge, &form); + if (form==2) + RenameSpec(rename, name, charge); + else + strcpy(rename, name); + jacobi[dyn-1][NoOfSpec()-NumOfConstraint()+NumOfDynVar()+j-1]=TreeCreate(); + temp_tree=TreeCreate(); + TreeDerive(temp_tree, tmp, rename); + TreeKill(tmp); + tmp=TreeCreate(); + TreeCpy(tmp, temp_tree); + TreeKill(temp_tree); + temp=TreeEval(tmp); + if ((TreeGetError()==NoEval) || (temp!=0.0)) { + fprintf(code, " g(%d, %d)=", dyn, NoOfSpec()-NumOfConstraint()+NumOfDynVar()+j-1); + TreePrint(tmp, 1, code); + fprintf(code, "\n"); + } /* if */ else + fprintf(code, " g(%d, %d)=%e\n", dyn, NoOfSpec()-NumOfConstraint()+NumOfDynVar()+j-1, temp); + TreeCpy(jacobi[dyn-1][NoOfSpec()-NumOfConstraint()+NumOfDynVar()+j-1], tmp); + TreeKill(tmp); + }; /* for j */ + for(j=1; j<=NumOfDynVar(); j++) { + jacobi[dyn-1][j-1+NoOfSpec()-NumOfConstraint()]=TreeCreate(); + tmp=TreeCreate(); + TreeCpy(tmp, v[dyn-1]); + GetDynVarNo(j, name); + temp_tree=TreeCreate(); + TreeDerive(temp_tree, tmp, rename); + TreeKill(tmp); + tmp=TreeCreate(); + TreeCpy(tmp, temp_tree); + TreeKill(temp_tree); + temp=TreeEval(tmp); + if ((TreeGetError()==NoEval) || (temp!=0.0)) { + fprintf(code, " g(%d, %d)=", dyn, j+(NoOfSpec()-NumOfConstraint())); + TreePrint(tmp, 1, code); + fprintf(code, "\n"); + }; /* if */ + TreeCpy(jacobi[dyn-1][j-1+NoOfSpec()-NumOfConstraint()], tmp); + TreeKill(tmp); + }; /* for j */ + }; /* if */ + }; /* for i */ + for(i=1; i<=NumOfParameter(); i++) { + GetParamNo(i, name, &charge, &form); + if (form==1) + strcpy(rename, name); + else + RenameSpec(rename, name, charge); + dyn=0; + for(j=1; j<=NoOfSpec(); j++) { + GetSpecNo(j, name, &charge); + if (IsSpecInConstraint(name, charge)==0) { + tmp=TreeCreate(); + TreeDerive(tmp, v[dyn], rename); + dyn++; + fprintf(code, " g(%d, %d)=", dyn, NoOfSpec()-NumOfConstraint()+i); + TreePrint(tmp, 1, code); + fprintf(code, "\n"); + TreeKill(tmp); + } /* if */ + } /* for j */ + } /* for i */ + +#ifdef HESSIAN + fprintf(code, " IF (n.LE.ndim*(nvar+1)) RETURN\n"); + dyn=0; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) { + dyn++; + dyn2=1; + for(j=1; j<=NoOfSpec(); j++) { + tmp=TreeCreate(); + GetSpecNo(j, name, &charge); + RenameSpec(rename, name, charge); + if (IsSpecInConstraint(name, charge)==0) { + TreeCpy(tmp, jacobi[dyn-1][dyn2-1]); + temp_tree=TreeCreate(); + TreeDerive(temp_tree, tmp, rename); + dyn3=1; + for(k=1; k<=NoOfSpec(); k++) { + GetSpecNo(k, name, &charge); + RenameSpec(rename, name, charge); + if (IsSpecInConstraint(name, charge)==0) { + tmp2=TreeCreate(); + TreeDerive(tmp2, temp_tree, rename); + fprintf(code, " h(%d, %d, %d)=", dyn, dyn2, dyn3); + TreePrint(tmp2, 1, code); + fprintf(code, "\n"); + dyn3++; + TreeKill(tmp2); + }; /* if */ + }; /* for k */ + for(k=1; k<=NumOfDynVar(); k++) { + GetDynVarNo(k, name); + tmp2=TreeCreate(); + TreeDerive(tmp2, temp_tree, name); + fprintf(code, " h(%d, %d, %d)=", dyn, dyn2, dyn3); + TreePrint(tmp2, 1, code); + fprintf(code, "\n"); + TreeKill(tmp2); + }; /* for k */ + dyn2++; + }; /* if */ + TreeKill(tmp); + TreeKill(temp_tree); + }; /* for j */ + for(j=1; j<=NumOfDynVar(); j++) { + tmp=TreeCreate(); + TreeCpy(tmp, jacobi[dyn-1][dyn2-1]); + GetDynVarNo(j, name); + temp_tree=TreeCreate(); + TreeDerive(temp_tree, tmp, name); + dyn3=1; + for(k=1; k<=NoOfSpec(); k++) { + GetSpecNo(k, name, &charge); + RenameSpec(rename, name, charge); + if (IsSpecInConstraint(name, charge)==0) { + tmp2=TreeCreate(); + TreeDerive(tmp2, temp_tree, rename); + fprintf(code, " h(%d, %d, %d)=", dyn, j+NoOfSpec()-NumOfConstraint(), dyn3); + TreePrint(tmp2, 1, code); + fprintf(code, "\n"); + dyn3++; + TreeKill(tmp2); + }; /* if */ + }; /* for k */ + dyn2++; + TreeKill(tmp); + TreeKill(temp_tree); + }; /* for j */ + }; /* if */ + }; /* for i */ +#endif + fprintf(code, " RETURN\n END\n"); +} /* SymbCont */ diff --git a/old_src/symbcont.h b/old_src/symbcont.h new file mode 100644 index 0000000..f3178b6 --- /dev/null +++ b/old_src/symbcont.h @@ -0,0 +1,7 @@ +/* Code generator SymbCont + CopyWrong by Kenneth Geisshirt, 1993 + + See kc.tex for details. +*/ + +extern void SymbCont(FILE *); diff --git a/old_src/vode.c b/old_src/vode.c new file mode 100644 index 0000000..544ff44 --- /dev/null +++ b/old_src/vode.c @@ -0,0 +1,179 @@ +/************************************************************************ + A code generator which is using VODE [1] as integrator. + + CopyWrong 1994 by + Kenneth Geisshirt (kneth@osc.kiku.dk) + Department of Theoretical Chemistry + H.C. Orsted Institute + Universitetsparken 5 + 2100 Copenhagen + Denmark + + Reference: + [1] VODE: A Variable-Coefficient ODE Solver. + P.N. Brown et al., SIAM J. Sci. Stat. Comp. + pp. 1038-1051, volume 10, number 5, 1989. + + Last updated: 17 August 1994 +************************************************************************/ + +#include +#include +#include + +#include "config.h" +#include "tableman.h" +#include "symbmath.h" +#include "misc.h" +#include "codegen.h" + +void VODE(FILE *code) { + + double charge, temp, coeff; + char name[STRING_LENGTH], rename[STRING_LENGTH]; + time_t timer; + Tree v_tree, tmp, temp_tree; + int i, j, react_no, finished, constraint, dyn, dyn2, NumbDynVars; + + timer=time(&timer); + + InitCodeGenVar(NoOfSpec()-NumOfConstraint()+NumOfDynVar(), + NumOfConstraint()); + + fprintf(code, "C--------------------------------------------------------\n"); + fprintf(code, "C WARNING: This file was generated by kc v%s\n", VERSION); + fprintf(code, "C CopyWrong Kenneth Geisshirt\n"); + fprintf(code, "C %s", ctime(&timer)); + fprintf(code, "C--------------------------------------------------------\n"); + + NumbDynVars=NoOfSpec()+NumOfDynVar()-NumOfConstraint(); + fprintf(code, " PROGRAM ODESOLV\n"); + fprintf(code, " DOUBLE PRECISION ATOL,RPAR,RTOL,RWORK,T,TOUT,Y\n"); + fprintf(code, " DIMENSION Y(%d),RWORK(%d),IWORK(%d),RPAR(%d),IPAR(%d)\n", + NumbDynVars, 22+9*NumbDynVars+2*NumbDynVars*NumbDynVars, + 30+NumbDynVars, 22+9*NumbDynVars+2*NumbDynVars*NumbDynVars, + 30+NumbDynVars); + fprintf(code, " INTEGER ITOL,ITASK,ISTATE,IOPT,LRW,LIW,MF,I,NEQ\n"); + fprintf(code, " NEQ=%d\n", NumbDynVars); + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) { + temp=GetBeginConc(name, charge); + if (GetError()==NotFound) + fprintf(code, " Y(%d)=0.0\n", dyn); + else + fprintf(code, " Y(%d)=%e\n", dyn, temp); + dyn++; + } + } + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + temp=GetInitValue(name); + if (GetError()==NotFound) + fprintf(code, " Y(%d)=0.0\n", i+NoOfSpec()-NumOfConstraint()); + else + fprintf(code, " Y(%d)=%e\n", i+NoOfSpec()-NumOfConstraint(), temp); + } + fprintf(code, " T=0.0D0\n"); + fprintf(code, " ITOL=1\n"); + fprintf(code, " ITASK=1\n"); + fprintf(code, " ISTATE=1\n"); + fprintf(code, " IOPT=0\n"); + fprintf(code, " LRW=%d\n", 22+9*NumbDynVars+2*NumbDynVars*NumbDynVars); + fprintf(code, " LIW=%d\n", 30+NumbDynVars); + fprintf(code, " MF=21\n"); + GetAndPrintConst("epsr", "RTOL", 1, 1e-10, code, 1); + GetAndPrintConst("epsa", "ATOL", 1, 1e-10, code, 1); + GetAndPrintConst("dtime", "TOUT", 1, 1.0, code, 1); + fprintf(code, " PRINT *,'BEGINNING INTEGRATION'\n"); + fprintf(code, " 1000 CALL DVODE(F,NEQ,Y,T,TOUT,ITOL,RTOL,ATOL,ITASK,\n"); + fprintf(code, " & ISTATE,IOPT,RWORK,LRW,IWORK,LIW,JAC,\n"); + fprintf(code, " & MF,RPAR,IPAR)\n"); + fprintf(code, " PRINT *,T,(Y(I),I=1,NEQ)\n"); + temp=GetConstant("etime"); + if (GetError()==NotFound) + temp=10.0; + fprintf(code, " IF (T.GT.%e) GOTO 1001\n", temp); + temp=GetConstant("dtime"); + if (GetError()==NotFound) + temp=1.0; + fprintf(code, " TOUT=TOUT+%e\n", temp); + fprintf(code, " GOTO 1000\n"); + fprintf(code, " 1001 END\n"); + + GenerateRateExpr(1, 0, 0, 0); + GenerateJacobi(1, 0); + + fprintf(code, " SUBROUTINE F(NEQ,T,YSTATE,YDOT,RPAR,IPAR)\n"); + fprintf(code, " DOUBLE PRECISION T,YSTATE,YDOT,RPAR\n"); + fprintf(code, " DIMENSION YSTATE(NEQ),YDOT(NEQ)\n"); + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) { + RenameSpec(rename, name, charge); + fprintf(code, " DOUBLE PRECISION %s\n", rename); + } + } + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(code, " DOUBLE PRECISION %s\n", name); + } + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) { + RenameSpec(rename, name, charge); + fprintf(code, " %s=YSTATE(%d)\n", rename, dyn); + dyn++; + } /* if */ + } /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(code, " %s=YSTATE(%d)\n", name, i+NoOfSpec()-NumOfConstraint()); + } /* for i */ + for(i=0; i + +extern void VODE(FILE *); diff --git a/src/Makefile b/src/Makefile new file mode 100644 index 0000000..5eb8d9e --- /dev/null +++ b/src/Makefile @@ -0,0 +1,55 @@ +OBJECTS = main.o tableman.o symbmath.o codegen.o misc.o codecall.o +NUMLIBS = eigen.o complex.o matrix.o quench.o +NUMDIR = ../Solvers +YACC = bison +LEX = flex +CC = gcc +CFLAGS = -O2 -D_PLATFORM_GCC_ +LIBS = -lm -ll +YFLAGS = -y +GENS = waves.o kncont.o kgode.o conis.o mixed.o +DIST = $(PREFIX)/bin + +kc: $(OBJECTS) $(GENS) $(NUMLIBS) + $(CC) $(CFLAGS) $(OBJECTS) $(GENS) $(NUMLIBS) $(LIBS) -o kc + strip kc + mv kc $(DIST) +main.o: config.h parser.c lex.c main.c + $(CC) $(CFLAGS) -c main.c +tableman.o: config.h tableman.c tableman.h + $(CC) $(CFLAGS) -c tableman.c +parser.c: config.h kc.y lex.c + $(YACC) $(YFLAGS) kc.y + mv y.tab.c parser.c +lex.c: kc.l + $(LEX) kc.l + mv lex.yy.c lex.c +symbmath.o: config.h symbmath.h symbmath.c + $(CC) $(CFLAGS) -c symbmath.c +codegen.o: config.h codegen.h codegen.c + $(CC) $(CFLAGS) -c codegen.c +waves.o: config.h waves.c waves.h + $(CC) $(CFLAGS) -c waves.c +kncont.o: config.h kncont.h kncont.c + $(CC) $(CFLAGS) -c kncont.c +kgode.o: config.h kgode.c kgode.h + $(CC) $(CFLAGS) -c kgode.c +mixed.o: config.h mixed.c mixed.h + $(CC) $(CFLAGS) -I$(NUMDIR) -c mixed.c +misc.o: misc.c config.h misc.h + $(CC) $(CFLAGS) -c misc.c +codecall.o: config.h codecall.c codecall.h + $(CC) $(CFLAGS) -c codecall.c +conis.o: config.h conis.c conis.h + $(CC) $(CFLAGS) -I$(NUMDIR) -c conis.c +eigen.o: $(NUMDIR)/eigen.c $(NUMDIR)/eigen.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/eigen.c +complex.o: $(NUMDIR)/complex.c $(NUMDIR)/complex.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/complex.c +matrix.o: $(NUMDIR)/matrix.c $(NUMDIR)/matrix.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/matrix.c +quench.o: $(NUMDIR)/quench.c $(NUMDIR)/quench.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/quench.c + +clean: + rm -f core *.o parser.c lex.c a.out kc *~ Makefile diff --git a/src/Makefile.AIX b/src/Makefile.AIX new file mode 100644 index 0000000..4662d6d --- /dev/null +++ b/src/Makefile.AIX @@ -0,0 +1,55 @@ +OBJECTS = main.o tableman.o symbmath.o codegen.o misc.o codecall.o +NUMLIBS = eigen.o complex.o matrix.o quench.o +NUMDIR = ../Solvers +YACC = yacc +LEX = lex +CC = xlc +CFLAGS = -O3 -qstrict -D_PLATFORM_AIX_ +LIBS = -lm -ll +YFLAGS = +GENS = waves.o kncont.o kgode.o conis.o mixed.o +DIST = $(PREFIX)/bin + +kc: $(OBJECTS) $(GENS) $(NUMLIBS) + $(CC) $(CFLAGS) $(OBJECTS) $(GENS) $(NUMLIBS) $(LIBS) -o kc + strip kc + mv kc $(DIST) +main.o: config.h parser.c lex.c main.c + $(CC) $(CFLAGS) -c main.c +tableman.o: config.h tableman.c tableman.h + $(CC) $(CFLAGS) -c tableman.c +parser.c: config.h kc.y lex.c + $(YACC) $(YFLAGS) kc.y + mv y.tab.c parser.c +lex.c: kc.l + $(LEX) kc.l + mv lex.yy.c lex.c +symbmath.o: config.h symbmath.h symbmath.c + $(CC) $(CFLAGS) -c symbmath.c +codegen.o: config.h codegen.h codegen.c + $(CC) $(CFLAGS) -c codegen.c +waves.o: config.h waves.c waves.h + $(CC) $(CFLAGS) -c waves.c +kncont.o: config.h kncont.h kncont.c + $(CC) $(CFLAGS) -c kncont.c +kgode.o: config.h kgode.c kgode.h + $(CC) $(CFLAGS) -c kgode.c +mixed.o: config.h mixed.c mixed.h + $(CC) $(CFLAGS) -I$(NUMDIR) -c mixed.c +misc.o: misc.c config.h misc.h + $(CC) $(CFLAGS) -c misc.c +codecall.o: config.h codecall.c codecall.h + $(CC) $(CFLAGS) -c codecall.c +conis.o: config.h conis.c conis.h + $(CC) $(CFLAGS) -I$(NUMDIR) -c conis.c +eigen.o: $(NUMDIR)/eigen.c $(NUMDIR)/eigen.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/eigen.c +complex.o: $(NUMDIR)/complex.c $(NUMDIR)/complex.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/complex.c +matrix.o: $(NUMDIR)/matrix.c $(NUMDIR)/matrix.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/matrix.c +quench.o: $(NUMDIR)/quench.c $(NUMDIR)/quench.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/quench.c + +clean: + rm -f core *.o parser.c lex.c a.out kc *~ Makefile diff --git a/src/Makefile.CVX b/src/Makefile.CVX new file mode 100644 index 0000000..6d96f29 --- /dev/null +++ b/src/Makefile.CVX @@ -0,0 +1,55 @@ +OBJECTS = main.o tableman.o symbmath.o codegen.o misc.o codecall.o +NUMLIBS = eigen.o matrix.o complex.o quench.o +NUMDIR = ../Solvers +YACC = yacc +LEX = lex +CC = cc +PC = pc +CFLAGS = -O -I/usr/include/sys -D_PLATFORM_CONVEX_ +LIBS = -L/usr/lib -ll -lm +YFLAGS = +GENS = waves.o kncont.o kgode.o conis.o mixed.o + +kc: $(OBJECTS) $(GENS) $(NUMLIBS) + $(CC) $(CFLAGS) $(OBJECTS) $(GENS) $(NUMLIBS) $(LIBS) -o kc + strip kc + mv kc $(PREFIX)/bin +main.o: config.h parser.c lex.c main.c + $(CC) $(CFLAGS) -c main.c +tableman.o: config.h tableman.c tableman.h + $(CC) $(CFLAGS) -c tableman.c +parser.c: config.h kc.y lex.c + $(YACC) $(YFLAGS) kc.y + mv y.tab.c parser.c +lex.c: kc.l + $(LEX) kc.l + mv lex.yy.c lex.c +symbmath.o: config.h symbmath.h symbmath.c + $(CC) $(CFLAGS) -c symbmath.c +codegen.o: config.h codegen.h codegen.c + $(CC) $(CFLAGS) -c codegen.c +waves.o: config.h waves.c waves.h + $(CC) $(CFLAGS) -c waves.c +kncont.o: config.h kncont.h kncont.c + $(CC) $(CFLAGS) -c kncont.c +kgode.o: config.h kgode.c kgode.h + $(CC) $(CFLAGS) -c kgode.c +mixed.o: config.h mixed.h mixed.c + $(CC) $(CFLAGS) -I$(NUMDIR) -I. -c mixed.c +misc.o: misc.c misc.h + $(CC) $(CFLAGS) -c misc.c +codecall.o: config.h codecall.c codecall.h + $(CC) $(CFLAGS) -c codecall.c +conis.o: config.h conis.h conis.c + $(CC) $(CFLAGS) -I$(NUMDIR) -I. -c conis.c +eigen.o: $(NUMDIR)/eigen.c $(NUMDIR)/eigen.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/eigen.c +complex.o: $(NUMDIR)/complex.c $(NUMDIR)/complex.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/complex.c +matrix.o: $(NUMDIR)/matrix.c $(NUMDIR)/matrix.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/matrix.c +quench.o: $(NUMDIR)/quench.c $(NUMDIR)/quench.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/quench.c + +clean: + rm -f *.o parser.o lex.c core a.out kc diff --git a/src/Makefile.DEBUG b/src/Makefile.DEBUG new file mode 100644 index 0000000..8d7f232 --- /dev/null +++ b/src/Makefile.DEBUG @@ -0,0 +1,56 @@ +OBJECTS = main.o tableman.o symbmath.o codegen.o misc.o codecall.o +NUMLIBS = eigen.o matrix.o complex.o quench.o +YACC = bison +LEX = flex +CC = gcc +CFLAGS = -O2 -D_PLATFORM_GCC_ -D_MALLOC_DEBUG_ -I/usr/debug_include +LIBS = -ldbmalloc -lm +YFLAGS = -y +GENS = waves.o kncont.o kgode.o conis.o mixed.o +RM = rm +RMFLAGS = -f +DIST = $(PREFIX)/bin + +kc: $(OBJECTS) $(GENS) $(NUMLIBS) + $(CC) $(CFLAGS) $(OBJECTS) $(GENS) $(NUMLIBS) $(LIBS) -o kc +# strip kc +# mv kc $(DIST) +main.o: config.h parser.c lex.c main.c + $(CC) $(CFLAGS) -c main.c +tableman.o: config.h tableman.c tableman.h + $(CC) $(CFLAGS) -c tableman.c +parser.c: config.h kc.y lex.c + $(YACC) $(YFLAGS) kc.y + mv y.tab.c parser.c +lex.c: kc.l + $(LEX) kc.l + mv lex.yy.c lex.c +symbmath.o: config.h symbmath.h symbmath.c + $(CC) $(CFLAGS) -c symbmath.c +codegen.o: config.h codegen.h codegen.c + $(CC) $(CFLAGS) -c codegen.c +waves.o: config.h waves.c waves.h + $(CC) $(CFLAGS) -c waves.c +kncont.o: config.h kncont.h kncont.c + $(CC) $(CFLAGS) -c kncont.c +kgode.o: config.h kgode.c kgode.h + $(CC) $(CFLAGS) -c kgode.c +mixed.o: config.h mixed.c mixed.h + $(CC) $(CFLAGS) -I. -I../Solvers -c mixed.c +misc.o: misc.c config.h misc.h + $(CC) $(CFLAGS) -c misc.c +codecall.o: config.h codecall.c codecall.h + $(CC) $(CFLAGS) -c codecall.c +conis.o: config.h conis.c conis.h + $(CC) $(CFLAGS) -I. -I../Solvers -c conis.c +eigen.o: ../Solvers/eigen.c ../Solvers/eigen.h + $(CC) $(CFLAGS) -c -I../Solvers ../Solvers/eigen.c +matrix.o: ../Solvers/matrix.c ../Solvers/matrix.h + $(CC) $(CFLAGS) -c -D_PLATFORM_LINUX_ -I../Solvers ../Solvers/matrix.c +complex.o: ../Solvers/complex.c ../Solvers/complex.h + $(CC) $(CFLAGS) -c -I../Solvers ../Solvers/complex.c +quench.o: ../Solvers/quench.c ../Solvers/quench.h + $(CC) $(CFLAGS) -c -I../Solvers ../Solvers/quench.c + +clean: + $(RM) $(RMFLAGS) *.o parser.c lex.c core.* diff --git a/src/Makefile.DOS b/src/Makefile.DOS new file mode 100644 index 0000000..d7a69f9 --- /dev/null +++ b/src/Makefile.DOS @@ -0,0 +1,50 @@ +OBJECTS = main.o tableman.o symbmath.o codegen.o misc.o codecall.o +NUMLIBS = eigen.o matrix.o complex.o quench.o +YACC = bison +LEX = flex +CC = gcc +CFLAGS = -O2 -m486 +LIBS = -lm +YFLAGS = -t -y +GENS = waves.o kncont.o kgode.o conis.o mixed.o +DIST = /usr/local/bin + +kc: $(OBJECTS) $(GENS) $(NUMLIBS) + $(CC) $(CFLAGS) $(OBJECTS) $(GENS) $(NUMLIBS) $(LIBS) -o kc + strip kc +main.o: config.h parser.c lex.c main.c + $(CC) $(CFLAGS) -c main.c +tableman.o: config.h tableman.c tableman.h + $(CC) $(CFLAGS) -c tableman.c +parser.c: config.h kc.y lex.c + $(YACC) $(YFLAGS) kc.y + copy y_tab.c parser.c +lex.c: kc.l + $(LEX) kc.l + copy lexyy.c lex.c +symbmath.o: config.h symbmath.h symbmath.c + $(CC) $(CFLAGS) -c symbmath.c +codegen.o: config.h codegen.h codegen.c + $(CC) $(CFLAGS) -c codegen.c +waves.o: config.h waves.c waves.h + $(CC) $(CFLAGS) -c waves.c +kncont.o: config.h kncont.h kncont.c + $(CC) $(CFLAGS) -c kncont.c +kgode.o: config.h kgode.c kgode.h + $(CC) $(CFLAGS) -c kgode.c +mixed.o: config.h mixed.c mixed.h + $(CC) $(CFLAGS) -c mixed.c +misc.o: misc.c config.h misc.h + $(CC) $(CFLAGS) -c misc.c +codecall.o: config.h codecall.c codecall.h + $(CC) $(CFLAGS) -c codecall.c +conis.o: config.h conis.c conis.h + $(CC) $(CFLAGS) -c conis.c +matrix.o: ../Solvers/matrix.h ../Solvers/matrix.c + $(CC) $(CFLAGS) -c -I../Solvers ../Solvers/matrix.c +complex.o: ../Solvers/complex.h ../Solvers/complex.c + $(CC) $(CFLAGS) -c -I../Solvers ../Solvers/complex.c +eigen.o: ../Solvers/eigen.h ../Solvers/eigen.c + $(CC) $(CFLAGS) -c -I../Solvers ../Solvers/eigen.c +quench.o: ../Solvers/quench.h ../Solvers/quench.c + $(CC) $(CFLAGS) -c -I../Solvers ../Solvers/quench.c diff --git a/src/Makefile.GC b/src/Makefile.GC new file mode 100644 index 0000000..c20a5ed --- /dev/null +++ b/src/Makefile.GC @@ -0,0 +1,56 @@ +OBJECTS = main.o tableman.o symbmath.o codegen.o misc.o codecall.o +NUMLIBS = eigen.o matrix.o complex.o quench.o +YACC = bison +LEX = flex +CC = gcc +CFLAGS = -O2 -D_PLATFORM_GCC_ -static -D_USE_GARBAGE_COL_ +LIBS = -lm -lgc +YFLAGS = -y +GENS = waves.o kncont.o kgode.o conis.o mixed.o +RM = rm +RMFLAGS = -f +DIST = $(PREFIX)/bin + +kc: $(OBJECTS) $(GENS) $(NUMLIBS) + $(CC) $(CFLAGS) $(OBJECTS) $(GENS) $(NUMLIBS) $(LIBS) -o kc + strip kc + mv kc $(DIST) +main.o: config.h parser.c lex.c main.c + $(CC) $(CFLAGS) -c main.c +tableman.o: config.h tableman.c tableman.h + $(CC) $(CFLAGS) -c tableman.c +parser.c: config.h kc.y lex.c + $(YACC) $(YFLAGS) kc.y + mv y.tab.c parser.c +lex.c: kc.l + $(LEX) kc.l + mv lex.yy.c lex.c +symbmath.o: config.h symbmath.h symbmath.c + $(CC) $(CFLAGS) -c symbmath.c +codegen.o: config.h codegen.h codegen.c + $(CC) $(CFLAGS) -c codegen.c +waves.o: config.h waves.c waves.h + $(CC) $(CFLAGS) -c waves.c +kncont.o: config.h kncont.h kncont.c + $(CC) $(CFLAGS) -c kncont.c +kgode.o: config.h kgode.c kgode.h + $(CC) $(CFLAGS) -c kgode.c +mixed.o: config.h mixed.c mixed.h + $(CC) $(CFLAGS) -I. -I../Solvers -c mixed.c +misc.o: misc.c config.h misc.h + $(CC) $(CFLAGS) -c misc.c +codecall.o: config.h codecall.c codecall.h + $(CC) $(CFLAGS) -c codecall.c +conis.o: config.h conis.c conis.h + $(CC) $(CFLAGS) -I. -I../Solvers -c conis.c +eigen.o: ../Solvers/eigen.c ../Solvers/eigen.h + $(CC) $(CFLAGS) -c -I../Solvers ../Solvers/eigen.c +matrix.o: ../Solvers/matrix.c ../Solvers/matrix.h + $(CC) $(CFLAGS) -c -D_PLATFORM_LINUX_ -I../Solvers ../Solvers/matrix.c +complex.o: ../Solvers/complex.c ../Solvers/complex.h + $(CC) $(CFLAGS) -c -I../Solvers ../Solvers/complex.c +quench.o: ../Solvers/quench.c ../Solvers/quench.h + $(CC) $(CFLAGS) -c -I../Solvers ../Solvers/quench.c + +clean: + $(RM) $(RMFLAGS) *.o parser.c lex.c diff --git a/src/Makefile.GCC b/src/Makefile.GCC new file mode 100644 index 0000000..5eb8d9e --- /dev/null +++ b/src/Makefile.GCC @@ -0,0 +1,55 @@ +OBJECTS = main.o tableman.o symbmath.o codegen.o misc.o codecall.o +NUMLIBS = eigen.o complex.o matrix.o quench.o +NUMDIR = ../Solvers +YACC = bison +LEX = flex +CC = gcc +CFLAGS = -O2 -D_PLATFORM_GCC_ +LIBS = -lm -ll +YFLAGS = -y +GENS = waves.o kncont.o kgode.o conis.o mixed.o +DIST = $(PREFIX)/bin + +kc: $(OBJECTS) $(GENS) $(NUMLIBS) + $(CC) $(CFLAGS) $(OBJECTS) $(GENS) $(NUMLIBS) $(LIBS) -o kc + strip kc + mv kc $(DIST) +main.o: config.h parser.c lex.c main.c + $(CC) $(CFLAGS) -c main.c +tableman.o: config.h tableman.c tableman.h + $(CC) $(CFLAGS) -c tableman.c +parser.c: config.h kc.y lex.c + $(YACC) $(YFLAGS) kc.y + mv y.tab.c parser.c +lex.c: kc.l + $(LEX) kc.l + mv lex.yy.c lex.c +symbmath.o: config.h symbmath.h symbmath.c + $(CC) $(CFLAGS) -c symbmath.c +codegen.o: config.h codegen.h codegen.c + $(CC) $(CFLAGS) -c codegen.c +waves.o: config.h waves.c waves.h + $(CC) $(CFLAGS) -c waves.c +kncont.o: config.h kncont.h kncont.c + $(CC) $(CFLAGS) -c kncont.c +kgode.o: config.h kgode.c kgode.h + $(CC) $(CFLAGS) -c kgode.c +mixed.o: config.h mixed.c mixed.h + $(CC) $(CFLAGS) -I$(NUMDIR) -c mixed.c +misc.o: misc.c config.h misc.h + $(CC) $(CFLAGS) -c misc.c +codecall.o: config.h codecall.c codecall.h + $(CC) $(CFLAGS) -c codecall.c +conis.o: config.h conis.c conis.h + $(CC) $(CFLAGS) -I$(NUMDIR) -c conis.c +eigen.o: $(NUMDIR)/eigen.c $(NUMDIR)/eigen.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/eigen.c +complex.o: $(NUMDIR)/complex.c $(NUMDIR)/complex.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/complex.c +matrix.o: $(NUMDIR)/matrix.c $(NUMDIR)/matrix.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/matrix.c +quench.o: $(NUMDIR)/quench.c $(NUMDIR)/quench.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/quench.c + +clean: + rm -f core *.o parser.c lex.c a.out kc *~ Makefile diff --git a/src/Makefile.HPUX b/src/Makefile.HPUX new file mode 100644 index 0000000..cce366b --- /dev/null +++ b/src/Makefile.HPUX @@ -0,0 +1,57 @@ +OBJECTS = main.o tableman.o symbmath.o codegen.o misc.o codecall.o +NUMLIBS = eigen.o matrix.o complex.o quench.o +NUMDIR = ../Solvers +YACC = yacc +LEX = lex +CC = cc +PC = pc +CFLAGS = -Aa -O -D_PLATFORM_HPUX_ +PFLAGS = -O -w +LIBS = -ly -ll -lm -lmalloc +YFLAGS = -t +GENS = waves.o kncont.o kgode.o conis.o mixed.o +DIST = $(PREFIX)/bin + +kc: $(OBJECTS) $(GENS) $(NUMLIBS) + $(CC) $(CFLAGS) $(OBJECTS) $(GENS) misc.o $(LIBS) $(NUMLIBS) -o kc + strip kc + mv kc $(DIST) +main.o: config.h parser.c lex.c main.c + $(CC) $(CFLAGS) -c main.c +tableman.o: config.h tableman.c tableman.h + $(CC) $(CFLAGS) -c tableman.c +parser.c: config.h kc.y lex.c + $(YACC) $(YFLAGS) kc.y + mv y.tab.c parser.c +lex.c: kc.l + $(LEX) kc.l + mv lex.yy.c lex.c +symbmath.o: config.h symbmath.h symbmath.c + $(CC) $(CFLAGS) -c symbmath.c +codegen.o: config.h codegen.h codegen.c + $(CC) $(CFLAGS) -c codegen.c +waves.o: config.h waves.c waves.h + $(CC) $(CFLAGS) -c waves.c +kncont.o: config.h kncont.h kncont.c + $(CC) $(CFLAGS) -c kncont.c +mixed.o: config.h mixed.h mixed.c + $(CC) $(CFLAGS) -c -I$(NUMDIR) -I. mixed.c +conis.o: config.h conis.h conis.c + $(CC) $(CFLAGS) -c -I$(NUMDIR) -I. conis.c +eigen.o: $(NUMDIR)/eigen.c $(NUMDIR)/eigen.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/eigen.c +matrix.o: $(NUMDIR)/matrix.c $(NUMDIR)/matrix.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/matrix.c +complex.o: $(NUMDIR)/complex.c $(NUMDIR)/complex.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/complex.c +quench.o: $(NUMDIR)/quench.c $(NUMDIR)/quench.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/quench.c +kgode.o: config.h kgode.c kgode.h + $(CC) $(CFLAGS) -c kgode.c +misc.o: misc.c misc.h + $(CC) $(CFLAGS) -c misc.c +codecall.o: config.h codecall.c codecall.h + $(CC) $(CFLAGS) -c codecall.c + +clean: + rm -f *.o core a.out kc parser.c lex.c diff --git a/src/Makefile.KIN b/src/Makefile.KIN new file mode 100644 index 0000000..035b67b --- /dev/null +++ b/src/Makefile.KIN @@ -0,0 +1,55 @@ +OBJECTS = main.o tableman.o symbmath.o codegen.o misc.o codecall.o +NUMLIBS = eigen.o complex.o matrix.o quench.o +NUMDIR = ../Solvers +YACC = bison +LEX = flex +CC = gcc +CFLAGS = -O3 -D_PLATFORM_GCC_ +LIBS = -lm -ll +YFLAGS = -y +GENS = waves.o kncont.o kgode.o conis.o mixed.o +DIST = $(PREFIX)/bin + +kc: $(OBJECTS) $(GENS) $(NUMLIBS) + $(CC) $(CFLAGS) $(OBJECTS) $(GENS) $(NUMLIBS) $(LIBS) -o kc + strip kc + mv kc $(DIST) +main.o: config.h parser.c lex.c main.c + $(CC) $(CFLAGS) -c main.c +tableman.o: config.h tableman.c tableman.h + $(CC) $(CFLAGS) -c tableman.c +parser.c: config.h kc.y lex.c + $(YACC) $(YFLAGS) kc.y + mv y.tab.c parser.c +lex.c: kc.l + $(LEX) kc.l + mv lex.yy.c lex.c +symbmath.o: config.h symbmath.h symbmath.c + $(CC) $(CFLAGS) -c symbmath.c +codegen.o: config.h codegen.h codegen.c + $(CC) $(CFLAGS) -c codegen.c +waves.o: config.h waves.c waves.h + $(CC) $(CFLAGS) -c waves.c +kncont.o: config.h kncont.h kncont.c + $(CC) $(CFLAGS) -c kncont.c +kgode.o: config.h kgode.c kgode.h + $(CC) $(CFLAGS) -c kgode.c +mixed.o: config.h mixed.c mixed.h + $(CC) $(CFLAGS) -I$(NUMDIR) -c mixed.c +conis.o: config.h conis.c conis.h + $(CC) $(CFLAGS) -I$(NUMDIR) -c conis.c +misc.o: misc.c config.h misc.h + $(CC) $(CFLAGS) -c misc.c +codecall.o: config.h codecall.c codecall.h + $(CC) $(CFLAGS) -c codecall.c +eigen.o: $(NUMDIR)/eigen.c $(NUMDIR)/eigen.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/eigen.c +complex.o: $(NUMDIR)/complex.c $(NUMDIR)/complex.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/complex.c +matrix.o: $(NUMDIR)/matrix.c $(NUMDIR)/matrix.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/matrix.c +quench.o: $(NUMDIR)/quench.c $(NUMDIR)/quench.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/quench.c + +clean: + rm -f core *.o parser.c lex.c a.out kc *~ Makefile diff --git a/src/Makefile.LINUX b/src/Makefile.LINUX new file mode 100644 index 0000000..3c9fc4c --- /dev/null +++ b/src/Makefile.LINUX @@ -0,0 +1,56 @@ +OBJECTS = main.o tableman.o symbmath.o codegen.o misc.o codecall.o +NUMLIBS = eigen.o matrix.o complex.o quench.o +YACC = bison +LEX = flex +CC = gcc +CFLAGS = -O2 -D_PLATFORM_GCC_ +LIBS = -lm +YFLAGS = -y +GENS = waves.o kncont.o kgode.o conis.o mixed.o +RM = rm +RMFLAGS = -f +DIST = $(PREFIX)/bin + +kc: $(OBJECTS) $(GENS) $(NUMLIBS) + $(CC) $(CFLAGS) $(OBJECTS) $(GENS) $(NUMLIBS) $(LIBS) -o kc + strip kc + mv kc $(DIST) +main.o: config.h parser.c lex.c main.c + $(CC) $(CFLAGS) -c main.c +tableman.o: config.h tableman.c tableman.h + $(CC) $(CFLAGS) -c tableman.c +parser.c: config.h kc.y lex.c + $(YACC) $(YFLAGS) kc.y + mv y.tab.c parser.c +lex.c: kc.l + $(LEX) kc.l + mv lex.yy.c lex.c +symbmath.o: config.h symbmath.h symbmath.c + $(CC) $(CFLAGS) -c symbmath.c +codegen.o: config.h codegen.h codegen.c + $(CC) $(CFLAGS) -c codegen.c +waves.o: config.h waves.c waves.h + $(CC) $(CFLAGS) -c waves.c +kncont.o: config.h kncont.h kncont.c + $(CC) $(CFLAGS) -c kncont.c +kgode.o: config.h kgode.c kgode.h + $(CC) $(CFLAGS) -c kgode.c +mixed.o: config.h mixed.c mixed.h + $(CC) $(CFLAGS) -I. -I../Solvers -c mixed.c +conis.o: config.h conis.c conis.h + $(CC) $(CFLAGS) -I. -I../Solvers -c conis.c +misc.o: misc.c config.h misc.h + $(CC) $(CFLAGS) -c misc.c +codecall.o: config.h codecall.c codecall.h + $(CC) $(CFLAGS) -c codecall.c +eigen.o: ../Solvers/eigen.c ../Solvers/eigen.h + $(CC) $(CFLAGS) -c -I../Solvers ../Solvers/eigen.c +matrix.o: ../Solvers/matrix.c ../Solvers/matrix.h + $(CC) $(CFLAGS) -c -D_PLATFORM_LINUX_ -I../Solvers ../Solvers/matrix.c +complex.o: ../Solvers/complex.c ../Solvers/complex.h + $(CC) $(CFLAGS) -c -I../Solvers ../Solvers/complex.c +quench.o: ../Solvers/quench.c ../Solvers/quench.h + $(CC) $(CFLAGS) -c -I../Solvers ../Solvers/quench.c + +clean: + $(RM) $(RMFLAGS) *.o parser.c lex.c core.* diff --git a/src/Makefile.SGI b/src/Makefile.SGI new file mode 100644 index 0000000..92ebc60 --- /dev/null +++ b/src/Makefile.SGI @@ -0,0 +1,56 @@ +OBJECTS = main.o tableman.o symbmath.o codegen.o misc.o codecall.o +NUMLIBS = eigen.o matrix.o complex.o quench.o +NUMDIR = ../Solvers +YACC = yacc +LEX = lex +CC = cc +CFLAGS = -O -D_PLATFORM_SGI_ -ansi -w +CFLAG2 = -O -D_PLATFORM_SGI -w +LIBS = -ly -ll -lm +YFLAGS = +GENS = waves.o kncont.o kgode.o conis.o mixed.o +DIST = $(PREFIX)/bin + +kc: $(OBJECTS) $(GENS) $(NUMLIBS) + $(CC) $(CFLAGS) $(OBJECTS) $(GENS) $(NUMLIBS) $(LIBS) -o kc + strip kc + mv kc $(DIST) +main.o: config.h parser.c lex.c main.c + $(CC) $(CFLAG2) -c main.c +tableman.o: config.h tableman.c tableman.h + $(CC) $(CFLAGS) -c tableman.c +parser.c: config.h kc.y lex.c + $(YACC) $(YFLAGS) kc.y + mv y.tab.c parser.c +lex.c: kc.l + $(LEX) kc.l + mv lex.yy.c lex.c +symbmath.o: config.h symbmath.h symbmath.c + $(CC) $(CFLAGS) -c symbmath.c +codegen.o: config.h codegen.h codegen.c + $(CC) $(CFLAGS) -c codegen.c +waves.o: config.h waves.c waves.h + $(CC) $(CFLAGS) -c waves.c +kncont.o: config.h kncont.h kncont.c + $(CC) $(CFLAGS) -c kncont.c +kgode.o: config.h kgode.c kgode.h + $(CC) $(CFLAGS) -c kgode.c +mixed.o: config.h mixed.c mixed.h + $(CC) $(CFLAGS) -I$(NUMDIR) -I. -c mixed.c +misc.o: misc.c config.h misc.h + $(CC) $(CFLAGS) -c misc.c +codecall.o: config.h codecall.c codecall.h + $(CC) $(CFLAGS) -c codecall.c +conis.o: config.h conis.c conis.h + $(CC) $(CFLAGS) -I$(NUMDIR) -I. -c conis.c +eigen.o: $(NUMDIR)/eigen.c $(NUMDIR)/eigen.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/eigen.c +complex.o: $(NUMDIR)/complex.c $(NUMDIR)/complex.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/complex.c +matrix.o: $(NUMDIR)/matrix.c $(NUMDIR)/matrix.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/matrix.c +quench.o: $(NUMDIR)/quench.c $(NUMDIR)/quench.h + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/quench.c + +clean: + rm -f core a.out kc *.o parser.c lex.c Makefile diff --git a/src/Makefile.ULTRI b/src/Makefile.ULTRI new file mode 100644 index 0000000..9e43400 --- /dev/null +++ b/src/Makefile.ULTRI @@ -0,0 +1,55 @@ +OBJECTS = main.o tableman.o symbmath.o codegen.o misc.o codecall.o +NUMLIBS = eigen.o matrix.o complex.o quench.o +NUMDIR = ../Solvers +YACC = yacc +LEX = lex +CC = cc +CFLAGS = -O2 -w -Olimit 1000 -D_PLATFORM_ULTRIX_ +LIBS = -ll -ly -lm +YFLAGS = +GENS = waves.o kncont.o kgode.o conis.o mixed.o +DIST = $(PREFIX)/bin + +kc: $(OBJECTS) $(GENS) $(NUMLIBS) + $(CC) $(CFLAGS) $(OBJECTS) $(GENS) $(NUMLIBS) $(LIBS) -o kc + strip kc + mv kc $(DIST) +main.o: config.h parser.c lex.c main.c + $(CC) $(CFLAGS) -c main.c +tableman.o: config.h tableman.c tableman.h + $(CC) $(CFLAGS) -c tableman.c +parser.c: config.h kc.y lex.c + $(YACC) $(YFLAGS) kc.y + mv y.tab.c parser.c +lex.c: kc.l + $(LEX) kc.l + mv lex.yy.c lex.c +symbmath.o: config.h symbmath.h symbmath.c + $(CC) $(CFLAGS) -c symbmath.c +codegen.o: config.h codegen.h codegen.c + $(CC) $(CFLAGS) -c codegen.c +waves.o: config.h waves.c waves.h + $(CC) $(CFLAGS) -c waves.c +kncont.o: config.h kncont.h kncont.c + $(CC) $(CFLAGS) -c kncont.c +kgode.o: config.h kgode.c kgode.h + $(CC) $(CFLAGS) -c kgode.c +mixed.o: config.h mixed.c mixed.h + $(CC) $(CFLAGS) -I$(NUMDIR) -I. -c mixed.c +misc.o: misc.c config.h misc.h + $(CC) $(CFLAGS) -c misc.c +codecall.o: config.h codecall.c codecall.h + $(CC) $(CFLAGS) -c codecall.c +conis.o: config.h conis.c conis.h + $(CC) $(CFLAGS) -I$(NUMDIR) -I. -c conis.c +eigen.o: $(NUMDIR)/eigen.h $(NUMDIR)/eigen.c + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/eigen.c +matrix.o: $(NUMDIR)/matrix.h $(NUMDIR)/matrix.c + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/matrix.c +complex.o: $(NUMDIR)/complex.h $(NUMDIR)/complex.c + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/complex.c +quench.o: $(NUMDIR)/quench.h $(NUMDIR)/quench.c + $(CC) $(CFLAGS) -c -I$(NUMDIR) $(NUMDIR)/quench.c + +clean: + rm -f *.o parser.c lex.c a.out kc core Makefile diff --git a/src/codecall.c b/src/codecall.c new file mode 100644 index 0000000..d087fa1 --- /dev/null +++ b/src/codecall.c @@ -0,0 +1,77 @@ +/************************************************************************* + CodeGenCall - callee of all code generators. + + CopyWrong 1993-1995 by + Kenneth Geisshirt (kneth@fatou.ruc.dk) + Department of Life Sciences and Chemistry + Roskilde University + P.O. Box 260 + 4000 Roskilde + Denmark + + See kc.tex for details. + + Last updated: 9 May 1995 by KN +**************************************************************************/ + + +#include +#include "config.h" +#include "tableman.h" + +/* import all code generators */ +#include "waves.h" +#include "kncont.h" +#include "kgode.h" +#include "conis.h" + +void CodeGenCall(int mode) { + +/************************************************************************** + modes: + 1 - Mixed - Different small programs (idea by K. Nielsen) + 2 - Waves - per1d/KGadi (K. Geisshirt) + 3 - KGode/kci (K. Geisshirt and K. Nielsen) + 4 - Output to a continuation program by I. Schreiber (K. Nielsen) + 5 - KnCont (K. Nielsen) +***************************************************************************/ + + FILE *code, *code_h, *code_c, *code_ini, *code_ini2; + int intgr; + + switch (mode) { + case 1: + Mixed(); + break; + case 2: + code_h=fopen("model.h", "w"); + code_c=fopen("model.c", "w"); + code_ini=fopen("in.dat", "w"); + Waves(code_h, code_c, code_ini); + fclose(code_ini); + fclose(code_c); + fclose(code_h); + break; + case 3: + code_c=fopen("model.c", "w"); + code_h=fopen("model.h", "w"); + KGode(code_c, code_h); + fclose(code_c); + fclose(code_h); + break; + case 4: + code_c=fopen("model.f", "w"); + ConIS(code_c); + fclose(code_c); + break; + case 5: + code_c=fopen("kcm5proc.p", "w"); + code_h=fopen("kcm5const.p", "w"); + KnCont(code_c, code_h); + fclose(code_c); + fclose(code_h); + break; + default: + fprintf(stderr, "CodeGenCall: mode %d is not supported. Run kc -h for help.\n", mode); + }; /* switch */ +} /* CodeGenCall */ diff --git a/src/codecall.h b/src/codecall.h new file mode 100644 index 0000000..9f80329 --- /dev/null +++ b/src/codecall.h @@ -0,0 +1,22 @@ +/************************************************************************ + CodeCall - procedure for calling code generators. + + CopyWrong 1993-1994 by + Kenneth Geisshirt (kneth@osc.kiku.dk) + Department of Theoretical Chemistry + H.C. Orsted Institute + Universitetsparken 5 + 2100 Copenhagen + Denmark + + See kc.tex for details. + + Last updated: 25 July 1994 +**************************************************************************/ + +#ifdef _CODECALL_ +#define _CODECALL_ + +void extern CodeGenCall(int); +#endif + diff --git a/src/codegen.c b/src/codegen.c new file mode 100644 index 0000000..0be45ff --- /dev/null +++ b/src/codegen.c @@ -0,0 +1,528 @@ +/**************************************************************************** + CodeGen - code generator routines for kc. + + CopyWrong 1992-199 by + Kenneth Geisshirt (kneth@fatou.ruc.dk) Keld Nielsen (kn@kin.kiku.dk) + Dept. of Life Sciences and Chemistry Dept. of Theoretical Chemistry + Roskilde University University of Copenhagen + P.O. Box 260 Universitetsparken 5 + DK-4000 Roskilde DK-2100 Copenhagen East + + See kc.tex for details. + + Last updated: 24 May 1996 by KG +*****************************************************************************/ + +#include +#include +#include "tableman.h" +#include "symbmath.h" +#include "config.h" +#include "codegen.h" +#include "misc.h" + +#ifdef _USE_GARBAGE_COL_ +# include +#else +# include +#endif + +/***************************************************************************** + Code generator independent routines (exported). + All routines are using global variables defined in the header file. +*****************************************************************************/ + +void InitCodeGenVar(int n, int m, int r) { + + int i, j, k; + +#ifdef _USE_GARBAGE_COL_ + v=(Tree *)GC_malloc(n*sizeof(Tree)); + con=(Tree *)GC_malloc(m*sizeof(Tree)); + jacobi=(Tree **)GC_malloc(n*sizeof(Tree *)); + for(i=0; in) { + rfwds=(Tree **)calloc(r, sizeof(TreeNode *)); + for(i=0; i0) + GetConstraintNo(constraint, name, &charge, tmp); + else + TreeAssignVar(tmp, rename); + TreePow(tmp, temp_tree); + TreeKill(temp_tree); + TreeMul(r[i-1], tmp); + TreeKill(tmp); + } /* if */ + finished=GetNextSpecA(name, &charge, &coeff, 0); + } /* while */ + } /* if */ + else { + GetRateExpr(react_no, uni, 1, r[i-1]); + for(j=1; j<=NoOfSpec(); j++) { + GetSpecNo(j, name, &charge); + constraint=IsSpecInConstraint(name, charge); + if (constraint>0) { + RenameSpec(rename, name, charge); + TreeSubstTree(r[i-1], rename, con[constraint-1]); + } /* if */ + } /* for j */ + } /* else */ + TreeCpy(rfw[i-1],r[i-1]); + TreeAssignConst(rrv[i-1],0.0); + break; /* case uni */ + case bi: + if (GetRateKind(react_no, bi, 1)==1) { + GetRateConst(react_no, bi, 1, r[i-1]); + finished=GetFirstSpecA(react_no, name, &charge, &coeff, 0); + while (finished==1) { + if (coeff!=0.0) { + RenameSpec(rename, name, charge); + temp=GetPowConstInReact(react_no, name, charge, 0); + temp_tree=TreeCreate(); + TreeAssignConst(temp_tree, temp); + tmp=TreeCreate(); + constraint=IsSpecInConstraint(name, charge); + if (constraint>0) + GetConstraintNo(constraint, name, &charge, tmp); + else + TreeAssignVar(tmp, rename); + TreePow(tmp, temp_tree); + TreeMul(r[i-1], tmp); + TreeKill(tmp); + TreeKill(temp_tree); + } /* if */ + finished=GetNextSpecA(name, &charge, &coeff, 0); + } /* while */ + } /* if */ + else { + GetRateExpr(react_no, bi, 1, r[i-1]); + for(j=1; j<=NoOfSpec(); j++) { + GetSpecNo(j, name, &charge); + constraint=IsSpecInConstraint(name, charge); + if (constraint>0) { + RenameSpec(rename, name, charge); + TreeSubstTree(r[i-1], rename, con[constraint-1]); + } /* if */ + } /* for j */ + } /* else */ + TreeCpy(rfw[i-1],r[i-1]); + v_temp=TreeCreate(); + if (GetRateKind(react_no, bi, 2)==1) { + GetRateConst(react_no, bi, 2, v_temp); + finished=GetFirstSpecA(react_no, name, &charge, &coeff, 1); + while (finished==1) { + if (coeff!=0.0) { + RenameSpec(rename, name, charge); + temp=GetPowConstInReact(react_no, name, charge, 1); + tmp=TreeCreate(); + temp_tree=TreeCreate(); + TreeAssignConst(temp_tree, temp); + constraint=IsSpecInConstraint(name, charge); + if (constraint>0) + GetConstraintNo(constraint, name, &charge, tmp); + else + TreeAssignVar(tmp, rename); + TreePow(tmp, temp_tree); + TreeMul(v_temp, tmp); + TreeKill(tmp); + TreeKill(temp_tree); + } /* if */ + finished=GetNextSpecA(name, &charge, &coeff, 1); + } /* while */ + } /* if */ + else { + GetRateExpr(react_no, bi, 2, v_temp); + for(j=1; j<=NoOfSpec(); j++) { + GetSpecNo(j, name, &charge); + constraint=IsSpecInConstraint(name, charge); + if (constraint>0) { + RenameSpec(rename, name, charge); + TreeSubstTree(v_temp, rename, con[constraint-1]); + } /* if */ + } /* for j */ + } /* else */ + TreeSub(r[i-1], v_temp); + TreeCpy(rrv[i-1],v_temp); + TreeKill(v_temp); + break; /* case bi */ + case equi: + fprintf(stderr, "Please use the construction: [J] = expr instead of equilibriums.\n"); + break; + }; /* switch */ + }; /* for i */ + dyn=0; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) { + v_store[dyn]=TreeCreate(); + for(j=1; j<=NoOfReact(); j++) { + if (j==1) { + tmp=TreeCreate(); + TreeAssignConst(tmp, 0.0); + } /* if */ + if (IsSpecInReact(GetReactNo(j-1), name, charge, &coeff)==1) { + v_temp=TreeCreate(); + TreeAssignConst(v_temp, -coeff); + TreeMul(v_temp, r[j-1]); + TreeAdd(tmp, v_temp); + TreeKill(v_temp); + } /* if */ + if (j==NoOfReact()) { + TreeCpy(v_store[dyn], tmp); + TreeKill(tmp); + } /* if */ + } /* for j */ + dyn++; + } /* if */ + } /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + v_store[i+NoOfSpec()-NumOfConstraint()-1]=TreeCreate(); + GetExprNo(i, name, v_store[i+NoOfSpec()-NumOfConstraint()-1]); + } /* for i */ + for(i=0; i<(NoOfSpec()-NumOfConstraint()+NumOfDynVar()+IsNonAutoSystem()); + i++) { + v[i]=TreeCreate(); + TreeCpy(v[i], v_store[i]); + TreeKill(v_store[i]); + } /* for i */ + + StringFree(name); + StringFree(rename); +} /* GenerateRateExpr */ + + +void GenerateJacobi(void) { + + double charge, temp, coeff; + char *name, *rename, *strtmp; + Tree v_temp, tmp, temp_tree; + int i, j, react_no, finished, constraint, dyn, dyn2, dyn3; + int jj; + + name=StringAlloc(); + rename=StringAlloc(); + strtmp=StringAlloc(); + + dyn=0; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) { + dyn++; + dyn2=1; + for(j=1; j<=NoOfSpec(); j++) { + tmp=TreeCreate(); + TreeCpy(tmp, v[dyn-1]); + GetSpecNo(j, name, &charge); + RenameSpec(rename, name, charge); + if (IsSpecInConstraint(name, charge)==0) { + jacobi[dyn-1][dyn2-1]=TreeCreate(); + temp_tree=TreeCreate(); + TreeDerive(temp_tree, tmp, rename); + TreeKill(tmp); + tmp=TreeCreate(); + TreeCpy(tmp, temp_tree); + TreeKill(temp_tree); + temp=TreeEval(tmp); + TreeCpy(jacobi[dyn-1][dyn2-1], tmp); + dyn2++; + } /* if */ + TreeKill(tmp); + } /* for j */ + for(j=1; j<=NumOfDynVar(); j++) { + jacobi[dyn-1][j-1+NoOfSpec()-NumOfConstraint()]=TreeCreate(); + tmp=TreeCreate(); + TreeCpy(tmp, v[dyn-1]); + GetDynVarNo(j, name); + temp_tree=TreeCreate(); + TreeDerive(temp_tree, tmp, name); + TreeKill(tmp); + tmp=TreeCreate(); + TreeCpy(tmp, temp_tree); + TreeKill(temp_tree); + TreeCpy(jacobi[dyn-1][j-1+NoOfSpec()-NumOfConstraint()], tmp); + TreeKill(tmp); + } /* for j */ + } /* if */ + } /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + dyn=0; + for(j=1; j<=NoOfSpec(); j++) { + GetSpecNo(j, name, &charge); + RenameSpec(rename, name, charge); + if (IsSpecInConstraint(name, charge)==0) { + dyn++; + jacobi[i+NoOfSpec()-NumOfConstraint()-1][dyn-1]=TreeCreate(); + TreeDerive(jacobi[i+NoOfSpec()-NumOfConstraint()-1][dyn-1], + v[i+NoOfSpec()-NumOfConstraint()-1], rename); + } /* if */ + } /* for j */ + for(j=1; j<=NumOfDynVar(); j++) { + GetDynVarNo(j, name); + jacobi[i+NoOfSpec()-NumOfConstraint()-1][j+NoOfSpec()-NumOfConstraint()-1]=TreeCreate(); + TreeDerive(jacobi[i+NoOfSpec()-NumOfConstraint()-1][j+NoOfSpec()-NumOfConstraint()-1], v[i+NoOfSpec()-NumOfConstraint()-1], name); + } /* for j */ + } /* for i */ + + StringFree(name); + StringFree(rename); + StringFree(strtmp); +} /* GenerateJacobi */ + +void GenerateHessian(void) { + + /* It is assumed that the jacobian is generated. */ + + double charge; + char *name, *rename; + int i, j, l, dyn; + int NumbOfDynVars; + + name=StringAlloc(); + rename=StringAlloc(); + + NumbOfDynVars=NoOfSpec()+NumOfDynVar()-NumOfConstraint(); + for(i=0; i +#include + +/**************************************************************************** + GenRateAndJac calculates the rate expressions and the jacobian matrix. The + storages needed is also allocated by this routine and the communication + is done by global variables. +*****************************************************************************/ + +void GenRateAndJac() { + + + int numcon; /* number of constaints */ + int numspec; /* number of species */ + int numdyn; /* number of dyn. variables */ + int numreact; /* number of reactions */ + + Tree tmp; /* temporary expression */ + char *name; /* species/dyn.var. name */ + double charge; /* charge of species */ + + + + /***** A few definitions *****/ + numcon=NumOfConstraint(); + numspec=NoOfSpec(); + numdyn=NoOfDynVar(); + numreact=NoOfReact(); + + + /***** Allocate storage *****/ + name=StringAlloc(); + + stoccon=(Tree *)calloc(numcon, sizeof(Tree)); + if (stoccon==NULL) fprintf(stderr, "GenRateAndJac: Not enough space\n"); + + rate=(Tree *)calloc(numdyn+numreact, sizeof(Tree)); + if (rate==NULL) fprintf(stderr, "GenRateAndJac: Not enough space\n"); + + stocdiff=(Tree **)calloc(numcon, sizeof(Tree *)); + if (stocdiff==NULL) fprintf(stderr, "GenRateAndJac: Not enough space\n"); + for(i=0; i +#include +#include +#include +#include "config.h" +#include "symbmath.h" +#include "tableman.h" +#include "codegen.h" +#include "misc.h" + +void ConIS(FILE *fcode) { + + double charge, temp, coeff, temp1, temp2; + char *name, *rename; + time_t timer; + Tree v_temp, tmp, temp_tree, tmp2; + int i, j, k, l, react_no, finished, constraint, dyn, dyn2, dyn3, form; + int NumbOfParams, NumbOfDynVars; + int need_dd_jac, BfErrorCode; + + name=StringAlloc(); + rename=StringAlloc(); + timer=time(&timer); + NumbOfParams=NumOfParameter(); + NumbOfDynVars=NoOfSpec()-NumOfConstraint()+NumOfDynVar(); + if ((NumbOfParams<2) || (NumbOfParams>40)) { + fprintf(stderr, "Continuation program aborted: Wrong number of parameters - should be between 2 and 40.\n"); + return; + } /* if */ + + InitCodeGenVar(NoOfSpec()+NumOfDynVar()-NumOfConstraint(), + NumOfConstraint(), NoOfReact()); + GenerateRateExpr(); + GenerateJacobi(); + + fprintf(fcode, "c ****************************************************\n"); + fprintf(fcode, "c WARNING: This file was generated by kc v%s\n", + VERSION); + fprintf(fcode, "c CopyWrong 1994 by Kenneth Geisshirt.\n"); + fprintf(fcode, "c %s", ctime(&timer)); + fprintf(fcode, "c ****************************************************\n"); + fprintf(fcode, "\n"); + + /* printing derivs */ + + fprintf(fcode, " subroutine model(ndim,nvar,n,tvar,xvar,fvar,gvar)\n"); + fprintf(fcode, "\n"); + fprintf(fcode, "c specification of the user's problem\n"); + fprintf(fcode, "c right hand sides and jacobi matrix of\n"); + fprintf(fcode, "c the model equations are evaluated here\n"); + fprintf(fcode, "c\n"); + fprintf(fcode, "c tvar : time (explicitly occures only for fodes)\n"); + fprintf(fcode, "c xvar() : array ndim state space variables\n"); + fprintf(fcode, "c fvar() : array ndim right hand sides depending on x;alpha,beta,par()\n"); + fprintf(fcode, "c (in addition f depends explicitly on t for fodes)\n"); + fprintf(fcode, "c gvar(,): ndim by ndim+2 matrix of first derivatives,\n"); + fprintf(fcode, "c gvar = [df/dx,df/dalpha,df/dbeta]\n"); + fprintf(fcode, "\n"); + fprintf(fcode, "c -------------------------------------------------------\n"); + fprintf(fcode, " implicit real*8(a-h,o-z)\n"); + fprintf(fcode, " dimension xvar(ndim),fvar(ndim),gvar(ndim,nvar)\n"); + fprintf(fcode, " common/fixp/"); + for(i=3; i<=NumbOfParams; i++) { + GetParamNo(i, name, &charge, &form); + if (form==2) + RenameSpec(rename, name, charge); + else + strcpy(rename, name); + fprintf(fcode, "%s,", rename); + } /* for i */ + fprintf(fcode, "dummy(%d)\n",42-NumbOfParams); + fprintf(fcode, " common/varp/"); + for(i=1; i<=2; i++) { + GetParamNo(i, name, &charge, &form); + if (form==2) + RenameSpec(rename, name, charge); + else + strcpy(rename, name); + fprintf(fcode, "%s,", rename); + } /* for i */ + fprintf(fcode, "arg,per\n"); + fprintf(fcode, "c -------------------------------------------------------\n"); + + + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + RenameSpec(rename, name, charge); + constraint=IsSpecInConstraint(name, charge); + if (constraint==0) { + fprintf(fcode, " %s = xvar(%d)\n", rename, dyn); + dyn++; + } /* if */ + } /* for i*/ + fprintf(fcode, "\n"); + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(fcode, " %s = xvar(%d)\n", name, + i+NoOfSpec()-NumOfConstraint()); + } /* for i */ + fprintf(fcode, "\n"); + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + RenameSpec(rename, name, charge); + constraint=IsSpecInConstraint(name, charge); + if (constraint>0) { + fprintf(fcode, " %s = ", rename); + TreePrint(con[constraint-1], 1, fcode); + fprintf(fcode, "\n"); + } /* if */ + } /* for i */ + fprintf(fcode, "\n"); + + for(i=1; i<=NumbOfDynVars; i++) { + fprintf(fcode, " fvar(%d) = ", i); + TreePrint(v[i-1], 1, fcode); + fprintf(fcode, "\n"); + } /* for i */ + fprintf(fcode, "\n"); + + for(i=1; i<=NumbOfDynVars; i++) { + for(j=1; j<=NumbOfDynVars; j++) { + temp=TreeEval(jacobi[i-1][j-1]); + fprintf(fcode, " gvar(%d,%d) = ", i, j); + TreePrint(jacobi[i-1][j-1], 1, fcode); + fprintf(fcode, "\n"); + } /* for j */ + fprintf(fcode, "\n"); + } /* for i */ + GetParamNo(1, name, &charge, &form); + if (form==1) + strcpy(rename, name); + else + RenameSpec(rename, name, charge); + for(j=0; j +#include +#include +#include +#include "config.h" +#include "symbmath.h" +#include "tableman.h" +#include "codegen.h" +#include "misc.h" + +extern void ConIS(FILE *); diff --git a/src/eigen.h b/src/eigen.h new file mode 100644 index 0000000..a4bbdf1 --- /dev/null +++ b/src/eigen.h @@ -0,0 +1,33 @@ +/***************************************************************************** + Eigen is a library for computing eigenvalues and eigenvectors of general + matrices. There is only one routine exported, namely Eigen. + + The meaning of the arguments to Eigen is: + 1. The dimension of the general matrix (n). + 2. A general matrix (A). + 3. The maximal number of iterations. + 4. The precision. + 5. A vector with the eigenvalues. + 6. A matrix with the eigenvectors. + + + CopyWrong 1994 by + Kenneth Geisshirt (kneth@osc.kiku.dk) + Department of Theoretical Chemistry + H.C. Orsted Institute + Universitetsparken 5 + 2100 Copenhagen + Denmark + + Last updated: 7 February 1995 , by KN +*****************************************************************************/ + +#ifndef _EIGEN_LIB_ +#define _EIGEN_LIB_ + +#include +#include "complex.h" + +extern void Eigen(int, int, double **, int, double, int, Complex *, Complex **); + +#endif diff --git a/src/finn.c b/src/finn.c new file mode 100644 index 0000000..9de1f04 --- /dev/null +++ b/src/finn.c @@ -0,0 +1,108 @@ +/************************************************************************* + Finn - a code generator for kc. + + CopyWrong 1993-1995 by + Kenneth Geisshirt (kneth@fatou.ruc.dk) + Department of Life Sciences and Chemistry + Roskilde University + P.O. Box 260 + 4000 Roskilde + Denmark + + See kc.tex for details + + Last updated: 15 February 1995 +*************************************************************************/ + +#include +#include +#include +#include "config.h" +#include "symbmath.h" +#include "tableman.h" +#include "misc.h" +#include "codegen.h" +#include "eigen.h" +#include "complex.h" +#include "matrix.h" + +void Finn(void) { + + double charge, temp; + char *name, *rename; + Tree tmp; + int i, j, l, no_eval=0; + int num_of_spec, max_iter; + double eps; + double **jac_num; + Complex *values, **vectors; + + name=StringAlloc(); + rename=StringAlloc(); + + num_of_spec=NoOfSpec()+NumOfDynVar()-NumOfConstraint(); + jac_num=(double **)calloc(num_of_spec, sizeof(double *)); + for(i=0; i +#include +#include +#include "symbmath.h" +#include "tableman.h" +#include "codecall.h" + +typedef enum {no, ini, ord} Conc; + +typedef struct compound { + char name[STRING_LENGTH]; + double charge; + Conc concs; +} compound; + +typedef struct Strnum { + int flag; + char name[STRING_LENGTH]; + double numb; +} Strnum; + +double coeff, charge, value, temp, temp1, temp2; +char flag, name[STRING_LENGTH], string[STRING_LENGTH]; +int i, j, side, lineno=1; +Tree tmp; + +# line 46 "kc.y" +typedef union { + double dval; + char oper; + char name[STRING_LENGTH]; + compound comp; + char flag; + Tree tree; + Function func; + Strnum strnum; +} YYSTYPE; +# define names 257 +# define leftarr 258 +# define rightarr 259 +# define numbers 260 +# define param 261 +# define print 262 +# define powop 263 +# define semicolon 264 +# define quotation 265 +# define equal 266 +# define colon 267 +# define R 268 +# define E 269 +# define powc 270 +# define leftpar 271 +# define rightpar 272 +# define oneway 273 +# define twoways 274 +# define plus 275 +# define minus 276 +# define multi 277 +# define pdiv 278 +# define comma 279 +# define leftconc 280 +# define rightconc 281 +# define time0 282 +# define K 283 +# define radical 284 +# define V 285 +# define prime 286 +# define fun_exp 287 +# define fun_log 288 +# define fun_ln 289 +# define fun_sin 290 +# define fun_cos 291 +# define fun_tan 292 +# define fun_sinh 293 +# define fun_cosh 294 +# define fun_tanh 295 +# define fun_asin 296 +# define fun_acos 297 +# define fun_atan 298 +# define fun_asinh 299 +# define fun_acosh 300 +# define fun_atanh 301 +# define UMINUS 302 +#define yyclearin yychar = -1 +#define yyerrok yyerrflag = 0 +extern int yychar; +extern int yyerrflag; +#ifndef YYMAXDEPTH +#define YYMAXDEPTH 150 +#endif +YYSTYPE yylval, yyval; +typedef int yytabelem; +#include +# define YYERRCODE 256 +yytabelem yyexca[] ={ + -1, 1, + 0, -1, + -2, 0, + }; +# define YYNPROD 83 +# define YYLAST 375 +yytabelem yyact[]={ + + 45, 31, 24, 46, 98, 99, 31, 33, 42, 71, + 37, 159, 33, 96, 44, 148, 25, 33, 88, 43, + 147, 73, 25, 18, 16, 38, 21, 10, 30, 27, + 49, 51, 50, 52, 53, 54, 55, 56, 57, 58, + 59, 60, 61, 62, 63, 45, 83, 18, 46, 18, + 120, 18, 18, 92, 39, 171, 163, 83, 104, 44, + 81, 82, 146, 134, 43, 102, 103, 101, 18, 79, + 80, 81, 82, 165, 101, 49, 51, 50, 52, 53, + 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, + 83, 117, 70, 162, 69, 83, 67, 66, 145, 64, + 83, 111, 79, 80, 81, 82, 164, 79, 80, 81, + 82, 157, 79, 80, 81, 82, 156, 83, 77, 124, + 11, 65, 83, 10, 12, 9, 121, 83, 83, 79, + 80, 81, 82, 144, 79, 80, 81, 82, 143, 79, + 80, 81, 82, 132, 83, 36, 167, 142, 141, 83, + 84, 140, 139, 75, 83, 76, 79, 80, 81, 82, + 131, 79, 80, 81, 82, 116, 79, 80, 81, 82, + 115, 83, 173, 6, 166, 83, 133, 158, 14, 138, + 137, 122, 83, 79, 80, 81, 82, 79, 80, 81, + 82, 125, 83, 119, 79, 80, 81, 82, 83, 118, + 41, 23, 83, 114, 79, 80, 81, 82, 26, 83, + 79, 80, 81, 82, 79, 80, 81, 82, 112, 83, + 78, 79, 80, 81, 82, 83, 35, 20, 15, 32, + 19, 79, 80, 81, 82, 8, 47, 79, 80, 81, + 82, 17, 29, 7, 85, 86, 22, 34, 5, 28, + 17, 13, 4, 3, 2, 1, 40, 123, 68, 48, + 100, 97, 95, 72, 0, 89, 74, 90, 91, 0, + 93, 94, 0, 0, 0, 22, 129, 87, 0, 0, + 106, 107, 108, 109, 110, 0, 0, 0, 0, 113, + 0, 0, 0, 0, 0, 0, 0, 152, 151, 0, + 0, 0, 0, 105, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 126, 127, 128, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 135, 136, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 149, 150, 0, 153, 0, 155, + 130, 0, 0, 0, 0, 0, 0, 160, 161, 0, + 0, 0, 0, 0, 168, 169, 170, 0, 0, 0, + 0, 0, 172, 0, 154 }; +yytabelem yypact[]={ + + -1000, -1000, -1000, -137, -233, -1000, -1000, -1000, -1000, -231, + -1000, -264, -228, -229, -1000, -1000, -270, -275, -112, -254, + -1000, -1000, -1000, -213, -257, -167, -143, -169, -170, -1000, + -265, -112, -172, -1000, -174, -272, -250, -1000, -231, -142, + -1000, -44, -107, -212, -212, -1000, -1000, -275, -253, -1000, + -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, -1000, + -1000, -1000, -1000, -1000, -212, -1000, -212, -212, -219, -212, + -212, -1000, -1000, -271, -1000, -208, -112, -1000, -1000, -212, + -212, -212, -212, -212, -164, -1000, -54, -1000, -212, -61, + -109, -114, -175, -65, -71, -222, -1000, -134, -1000, -1000, + -1000, -142, -1000, -1000, -1000, -1000, -217, -217, -135, -135, + -1000, -145, -1000, -81, -1000, -212, -212, -212, -1000, -1000, + -1000, -1000, -142, -112, -1000, -1000, -119, -136, -88, -201, + -1000, -212, -212, -1000, -110, -141, -146, -1000, -166, -1000, + -1000, -204, -251, -212, -212, -110, -212, -112, -212, -163, + -168, -1000, -1000, -38, -261, -38, -212, -212, -171, -210, + -173, -206, -113, -212, -212, -212, -1000, -211, -38, -38, + -38, -212, -92, -1000 }; +yytabelem yypgo[]={ + + 0, 200, 263, 262, 155, 261, 229, 260, 226, 236, + 153, 259, 256, 255, 254, 253, 252, 251, 248, 243, + 235, 230, 227, 208, 173, 201, 181, 180, 179, 152, + 151, 177, 174, 228 }; +yytabelem yyr1[]={ + + 0, 14, 13, 15, 15, 18, 18, 18, 19, 12, + 12, 21, 21, 22, 22, 20, 23, 23, 16, 16, + 25, 26, 24, 24, 27, 27, 28, 28, 30, 31, + 29, 29, 32, 32, 7, 7, 7, 10, 10, 8, + 2, 2, 3, 3, 3, 5, 5, 4, 4, 17, + 17, 33, 33, 33, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 11, 11, 11, 11, 11, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + 9, 6, 6 }; +yytabelem yyr2[]={ + + 0, 1, 9, 4, 0, 2, 2, 6, 7, 5, + 9, 6, 2, 3, 3, 6, 27, 27, 2, 4, + 1, 1, 18, 11, 6, 2, 6, 2, 13, 1, + 12, 7, 1, 9, 3, 3, 3, 5, 9, 5, + 7, 1, 3, 5, 3, 3, 3, 3, 1, 2, + 4, 11, 15, 11, 5, 7, 7, 7, 7, 7, + 7, 3, 3, 5, 9, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 7, 1, 3 }; +yytabelem yychk[]={ + + -1000, -13, -14, -15, -16, -18, -24, -19, -20, 262, + 260, 257, 261, -17, -24, -33, 257, -9, 280, -21, + -22, 257, -9, -25, 266, 286, -23, 257, -9, -33, + 257, 271, -6, 282, -6, -8, 257, 264, 279, 267, + -12, -1, 265, 276, 271, 257, 260, -9, -11, 287, + 289, 288, 290, 291, 292, 293, 294, 295, 296, 297, + 298, 299, 300, 301, 266, 264, 266, 266, -8, 266, + 266, 281, -2, 271, -22, -10, -4, 260, 264, 275, + 276, 277, 278, 263, 257, -1, -1, -6, 271, -1, + -1, -1, 272, -1, -1, -3, 284, -5, 275, 276, + -7, 275, 273, 274, 266, -8, -1, -1, -1, -1, + -1, 265, 272, -1, 264, 279, 279, 266, 264, 264, + 272, 260, -26, -4, 264, 272, -1, -1, -1, -10, + -8, 279, 279, 264, 264, -1, -1, -27, -28, -29, + -30, 258, 257, 279, 279, 264, 266, 271, 266, -1, + -1, -29, -30, -1, -8, -1, 279, 279, -31, 272, + -1, -1, 264, 266, 279, 279, -32, 259, -1, -1, + -1, 266, -1, 264 }; +yytabelem yydef[]={ + + 1, -2, 4, 0, 0, 3, 18, 5, 6, 0, + 20, 0, 0, 2, 19, 49, 81, 81, 0, 0, + 12, 13, 14, 0, 0, 0, 0, 0, 0, 50, + 81, 0, 0, 82, 0, 0, 41, 7, 0, 48, + 8, 0, 0, 0, 0, 61, 62, 81, 0, 65, + 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, + 76, 77, 78, 79, 0, 15, 0, 0, 0, 0, + 0, 80, 39, 0, 11, 0, 0, 47, 9, 0, + 0, 0, 0, 0, 0, 54, 0, 63, 0, 0, + 0, 0, 0, 0, 0, 0, 42, 44, 45, 46, + 21, 48, 34, 35, 36, 37, 55, 56, 57, 58, + 59, 0, 60, 0, 23, 0, 0, 0, 53, 51, + 40, 43, 48, 0, 10, 64, 0, 0, 0, 0, + 38, 0, 0, 52, 0, 0, 0, 22, 0, 25, + 27, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 24, 26, 29, 0, 31, 0, 0, 0, 0, + 0, 0, 32, 0, 0, 0, 30, 0, 28, 16, + 17, 0, 0, 33 }; +typedef struct { char *t_name; int t_val; } yytoktype; +#ifndef YYDEBUG +# define YYDEBUG 0 /* don't allow debugging */ +#endif + +#if YYDEBUG + +char * yyreds[] = +{ + "-no such reduction-", + "system : /* empty */", + "system : declars reactions constants", + "declars : declars declar", + "declars : /* empty */", + "declar : constant", + "declar : parameter", + "declar : print printlist semicolon", + "constant : names equal strnumb", + "strnumb : expr semicolon", + "strnumb : quotation names quotation semicolon", + "printlist : printlist comma prn_entry", + "printlist : prn_entry", + "prn_entry : names", + "prn_entry : conc", + "parameter : param pentry semicolon", + "pentry : names equal expr comma expr comma expr comma expr comma expr comma expr", + "pentry : conc equal expr comma expr comma expr comma expr comma expr comma expr", + "reactions : reaction", + "reactions : reactions reaction", + "reaction : numbers", + "reaction : numbers colon substs kind", + "reaction : numbers colon substs kind substs semicolon reackonst", + "reaction : names prime equal expr semicolon", + "reackonst : powconsts semicolon rateconsts", + "reackonst : rateconsts", + "powconsts : powconsts semicolon powconst", + "powconsts : powconst", + "powconst : names leftpar subst rightpar equal expr", + "rateconsts : leftarr equal expr", + "rateconsts : leftarr equal expr semicolon ropt", + "rateconsts : names equal expr", + "ropt : /* empty */", + "ropt : rightarr equal expr semicolon", + "kind : oneway", + "kind : twoways", + "kind : equal", + "substs : coeff subst", + "substs : substs plus coeff subst", + "subst : names charge", + "charge : leftpar size rightpar", + "charge : /* empty */", + "size : radical", + "size : sign numbers", + "size : sign", + "sign : plus", + "sign : minus", + "coeff : numbers", + "coeff : /* empty */", + "constants : const", + "constants : constants const", + "const : conc timeopt equal expr semicolon", + "const : names leftpar subst rightpar equal expr semicolon", + "const : names timeopt equal expr semicolon", + "expr : minus expr", + "expr : expr plus expr", + "expr : expr minus expr", + "expr : expr multi expr", + "expr : expr pdiv expr", + "expr : expr powop expr", + "expr : leftpar expr rightpar", + "expr : names", + "expr : numbers", + "expr : conc timeopt", + "expr : function leftpar expr rightpar", + "function : fun_exp", + "function : fun_ln", + "function : fun_log", + "function : fun_sin", + "function : fun_cos", + "function : fun_tan", + "function : fun_sinh", + "function : fun_cosh", + "function : fun_tanh", + "function : fun_asin", + "function : fun_acos", + "function : fun_atan", + "function : fun_asinh", + "function : fun_acosh", + "function : fun_atanh", + "conc : leftconc subst rightconc", + "timeopt : /* empty */", + "timeopt : time0", +}; +yytoktype yytoks[] = +{ + "names", 257, + "leftarr", 258, + "rightarr", 259, + "numbers", 260, + "param", 261, + "print", 262, + "powop", 263, + "semicolon", 264, + "quotation", 265, + "equal", 266, + "colon", 267, + "R", 268, + "E", 269, + "powc", 270, + "leftpar", 271, + "rightpar", 272, + "oneway", 273, + "twoways", 274, + "plus", 275, + "minus", 276, + "multi", 277, + "pdiv", 278, + "comma", 279, + "leftconc", 280, + "rightconc", 281, + "time0", 282, + "K", 283, + "radical", 284, + "V", 285, + "prime", 286, + "fun_exp", 287, + "fun_log", 288, + "fun_ln", 289, + "fun_sin", 290, + "fun_cos", 291, + "fun_tan", 292, + "fun_sinh", 293, + "fun_cosh", 294, + "fun_tanh", 295, + "fun_asin", 296, + "fun_acos", 297, + "fun_atan", 298, + "fun_asinh", 299, + "fun_acosh", 300, + "fun_atanh", 301, + "UMINUS", 302, + "-unknown-", -1 /* ends search */ +}; +#endif /* YYDEBUG */ + +/* @(#)27 1.7.1.3 src/bos/usr/ccs/bin/yacc/yaccpar, cmdlang, bos411, 9432B411a 8/10/94 14:01:53 */ +/* + * COMPONENT_NAME: (CMDLANG) Language Utilities + * + * FUNCTIONS: yyparse + * ORIGINS: 3 + */ +/* +** Skeleton parser driver for yacc output +*/ + +/* +** yacc user known macros and defines +*/ +#ifdef YYSPLIT +# define YYERROR return(-2) +#else +# define YYERROR goto yyerrlab +#endif +#ifdef YACC_MSG +#ifndef _XOPEN_SOURCE +#define _XOPEN_SOURCE +#endif +#include +nl_catd yyusercatd; +#endif +#define YYACCEPT return(0) +#define YYABORT return(1) +#ifndef YACC_MSG +#define YYBACKUP( newtoken, newvalue )\ +{\ + if ( yychar >= 0 || ( yyr2[ yytmp ] >> 1 ) != 1 )\ + {\ + yyerror( "syntax error - cannot backup" );\ + YYERROR;\ + }\ + yychar = newtoken;\ + yystate = *yyps;\ + yylval = newvalue;\ + goto yynewstate;\ +} +#else +#define YYBACKUP( newtoken, newvalue )\ +{\ + if ( yychar >= 0 || ( yyr2[ yytmp ] >> 1 ) != 1 )\ + {\ + yyusercatd=catopen("yacc_user.cat", NL_CAT_LOCALE);\ + yyerror(catgets(yyusercatd,1,1,"syntax error - cannot backup" ));\ + YYERROR;\ + }\ + yychar = newtoken;\ + yystate = *yyps;\ + yylval = newvalue;\ + goto yynewstate;\ +} +#endif +#define YYRECOVERING() (!!yyerrflag) +#ifndef YYDEBUG +# define YYDEBUG 1 /* make debugging available */ +#endif + +/* +** user known globals +*/ +int yydebug; /* set to 1 to get debugging */ + +/* +** driver internal defines +*/ +#define YYFLAG (-1000) + +#ifdef YYSPLIT +# define YYSCODE { \ + extern int (*_yyf[])(); \ + register int yyret; \ + if (_yyf[yytmp]) \ + if ((yyret=(*_yyf[yytmp])()) == -2) \ + goto yyerrlab; \ + else if (yyret>=0) return(yyret); \ + } +#endif + +/* +** global variables used by the parser +*/ +YYSTYPE yyv[ YYMAXDEPTH ]; /* value stack */ +int yys[ YYMAXDEPTH ]; /* state stack */ + +YYSTYPE *yypv; /* top of value stack */ +YYSTYPE *yypvt; /* top of value stack for $vars */ +int *yyps; /* top of state stack */ + +int yystate; /* current state */ +int yytmp; /* extra var (lasts between blocks) */ + +int yynerrs; /* number of errors */ +int yyerrflag; /* error recovery flag */ +int yychar; /* current input token number */ + +#ifdef __cplusplus + #ifdef _CPP_IOSTREAMS + #include + extern void yyerror (char *); /* error message routine -- iostream version */ + #else + #include + extern "C" void yyerror (char *); /* error message routine -- stdio version */ + #endif /* _CPP_IOSTREAMS */ + extern "C" int yylex(void); /* return the next token */ +#endif /* __cplusplus */ + + +/* +** yyparse - return 0 if worked, 1 if syntax error not recovered from +*/ +#ifdef __cplusplus +extern "C" +#endif /* __cplusplus */ +int +yyparse() +{ + /* + ** Initialize externals - yyparse may be called more than once + */ + yypv = &yyv[-1]; + yyps = &yys[-1]; + yystate = 0; + yytmp = 0; + yynerrs = 0; + yyerrflag = 0; + yychar = -1; +#ifdef YACC_MSG + yyusercatd=catopen("yacc_user.cat", NL_CAT_LOCALE); +#endif + goto yystack; + { + register YYSTYPE *yy_pv; /* top of value stack */ + register int *yy_ps; /* top of state stack */ + register int yy_state; /* current state */ + register int yy_n; /* internal state number info */ + + /* + ** get globals into registers. + ** branch to here only if YYBACKUP was called. + */ + yynewstate: + yy_pv = yypv; + yy_ps = yyps; + yy_state = yystate; + goto yy_newstate; + + /* + ** get globals into registers. + ** either we just started, or we just finished a reduction + */ + yystack: + yy_pv = yypv; + yy_ps = yyps; + yy_state = yystate; + + /* + ** top of for (;;) loop while no reductions done + */ + yy_stack: + /* + ** put a state and value onto the stacks + */ +#if YYDEBUG + /* + ** if debugging, look up token value in list of value vs. + ** name pairs. 0 and negative (-1) are special values. + ** Note: linear search is used since time is not a real + ** consideration while debugging. + */ + if ( yydebug ) + { + register int yy_i; + +#if defined(__cplusplus) && defined(_CPP_IOSTREAMS) + cout << "State " << yy_state << " token "; + if ( yychar == 0 ) + cout << "end-of-file" << endl; + else if ( yychar < 0 ) + cout << "-none-" << endl; +#else + printf( "State %d, token ", yy_state ); + if ( yychar == 0 ) + printf( "end-of-file\n" ); + else if ( yychar < 0 ) + printf( "-none-\n" ); +#endif /* defined(__cplusplus) && defined(_CPP_IOSTREAMS) */ + else + { + for ( yy_i = 0; yytoks[yy_i].t_val >= 0; + yy_i++ ) + { + if ( yytoks[yy_i].t_val == yychar ) + break; + } +#if defined(__cplusplus) && defined(_CPP_IOSTREAMS) + cout << yytoks[yy_i].t_name << endl; +#else + printf( "%s\n", yytoks[yy_i].t_name ); +#endif /* defined(__cplusplus) && defined(_CPP_IOSTREAMS) */ + } + } +#endif /* YYDEBUG */ + if ( ++yy_ps >= &yys[ YYMAXDEPTH ] ) /* room on stack? */ + { +#ifndef YACC_MSG + yyerror( "yacc stack overflow" ); +#else + yyerror(catgets(yyusercatd,1,2,"yacc stack overflow" )); +#endif + YYABORT; + } + *yy_ps = yy_state; + *++yy_pv = yyval; + + /* + ** we have a new state - find out what to do + */ + yy_newstate: + if ( ( yy_n = yypact[ yy_state ] ) <= YYFLAG ) + goto yydefault; /* simple state */ +#if YYDEBUG + /* + ** if debugging, need to mark whether new token grabbed + */ + yytmp = yychar < 0; +#endif + if ( ( yychar < 0 ) && ( ( yychar = yylex() ) < 0 ) ) + yychar = 0; /* reached EOF */ +#if YYDEBUG + if ( yydebug && yytmp ) + { + register int yy_i; + +#if defined(__cplusplus) && defined(_CPP_IOSTREAMS) + cout << "Received token " << endl; + if ( yychar == 0 ) + cout << "end-of-file" << endl; + else if ( yychar < 0 ) + cout << "-none-" << endl; +#else + printf( "Received token " ); + if ( yychar == 0 ) + printf( "end-of-file\n" ); + else if ( yychar < 0 ) + printf( "-none-\n" ); +#endif /* defined(__cplusplus) && defined(_CPP_IOSTREAMS) */ + else + { + for ( yy_i = 0; yytoks[yy_i].t_val >= 0; + yy_i++ ) + { + if ( yytoks[yy_i].t_val == yychar ) + break; + } +#if defined(__cplusplus) && defined(_CPP_IOSTREAMS) + cout << yytoks[yy_i].t_name << endl; +#else + printf( "%s\n", yytoks[yy_i].t_name ); +#endif /* defined(__cplusplus) && defined(_CPP_IOSTREAMS) */ + } + } +#endif /* YYDEBUG */ + if ( ( ( yy_n += yychar ) < 0 ) || ( yy_n >= YYLAST ) ) + goto yydefault; + if ( yychk[ yy_n = yyact[ yy_n ] ] == yychar ) /*valid shift*/ + { + yychar = -1; + yyval = yylval; + yy_state = yy_n; + if ( yyerrflag > 0 ) + yyerrflag--; + goto yy_stack; + } + + yydefault: + if ( ( yy_n = yydef[ yy_state ] ) == -2 ) + { +#if YYDEBUG + yytmp = yychar < 0; +#endif + if ( ( yychar < 0 ) && ( ( yychar = yylex() ) < 0 ) ) + yychar = 0; /* reached EOF */ +#if YYDEBUG + if ( yydebug && yytmp ) + { + register int yy_i; + +#if defined(__cplusplus) && defined(_CPP_IOSTREAMS) + cout << "Received token " << endl; + if ( yychar == 0 ) + cout << "end-of-file" << endl; + else if ( yychar < 0 ) + cout << "-none-" << endl; +#else + printf( "Received token " ); + if ( yychar == 0 ) + printf( "end-of-file\n" ); + else if ( yychar < 0 ) + printf( "-none-\n" ); +#endif /* defined(__cplusplus) && defined(_CPP_IOSTREAMS) */ + else + { + for ( yy_i = 0; + yytoks[yy_i].t_val >= 0; + yy_i++ ) + { + if ( yytoks[yy_i].t_val + == yychar ) + { + break; + } + } +#if defined(__cplusplus) && defined(_CPP_IOSTREAMS) + cout << yytoks[yy_i].t_name << endl; +#else + printf( "%s\n", yytoks[yy_i].t_name ); +#endif /* defined(__cplusplus) && defined(_CPP_IOSTREAMS) */ + } + } +#endif /* YYDEBUG */ + /* + ** look through exception table + */ + { + register int *yyxi = yyexca; + + while ( ( *yyxi != -1 ) || + ( yyxi[1] != yy_state ) ) + { + yyxi += 2; + } + while ( ( *(yyxi += 2) >= 0 ) && + ( *yyxi != yychar ) ) + ; + if ( ( yy_n = yyxi[1] ) < 0 ) + YYACCEPT; + } + } + + /* + ** check for syntax error + */ + if ( yy_n == 0 ) /* have an error */ + { + /* no worry about speed here! */ + switch ( yyerrflag ) + { + case 0: /* new error */ +#ifndef YACC_MSG + yyerror( "syntax error" ); +#else + yyerror(catgets(yyusercatd,1,3,"syntax error" )); +#endif + goto skip_init; + yyerrlab: + /* + ** get globals into registers. + ** we have a user generated syntax type error + */ + yy_pv = yypv; + yy_ps = yyps; + yy_state = yystate; + yynerrs++; + skip_init: + case 1: + case 2: /* incompletely recovered error */ + /* try again... */ + yyerrflag = 3; + /* + ** find state where "error" is a legal + ** shift action + */ + while ( yy_ps >= yys ) + { + yy_n = yypact[ *yy_ps ] + YYERRCODE; + if ( yy_n >= 0 && yy_n < YYLAST && + yychk[yyact[yy_n]] == YYERRCODE) { + /* + ** simulate shift of "error" + */ + yy_state = yyact[ yy_n ]; + goto yy_stack; + } + /* + ** current state has no shift on + ** "error", pop stack + */ +#if YYDEBUG + if ( yydebug ) +#if defined(__cplusplus) && defined(_CPP_IOSTREAMS) + cout << "Error recovery pops state " + << (*yy_ps) + << ", uncovers state " + << yy_ps[-1] << endl; +#else +# define _POP_ "Error recovery pops state %d, uncovers state %d\n" + printf( _POP_, *yy_ps, + yy_ps[-1] ); +# undef _POP_ +#endif /* defined(__cplusplus) && defined(_CPP_IOSTREAMS) */ +#endif + yy_ps--; + yy_pv--; + } + /* + ** there is no state on stack with "error" as + ** a valid shift. give up. + */ + YYABORT; + case 3: /* no shift yet; eat a token */ +#if YYDEBUG + /* + ** if debugging, look up token in list of + ** pairs. 0 and negative shouldn't occur, + ** but since timing doesn't matter when + ** debugging, it doesn't hurt to leave the + ** tests here. + */ + if ( yydebug ) + { + register int yy_i; + +#if defined(__cplusplus) && defined(_CPP_IOSTREAMS) + cout << "Error recovery discards "; + if ( yychar == 0 ) + cout << "token end-of-file" << endl; + else if ( yychar < 0 ) + cout << "token -none-" << endl; +#else + printf( "Error recovery discards " ); + if ( yychar == 0 ) + printf( "token end-of-file\n" ); + else if ( yychar < 0 ) + printf( "token -none-\n" ); +#endif /* defined(__cplusplus) && defined(_CPP_IOSTREAMS) */ + else + { + for ( yy_i = 0; + yytoks[yy_i].t_val >= 0; + yy_i++ ) + { + if ( yytoks[yy_i].t_val + == yychar ) + { + break; + } + } +#if defined(__cplusplus) && defined(_CPP_IOSTREAMS) + cout << "token " << + yytoks[yy_i].t_name << + endl; +#else + printf( "token %s\n", + yytoks[yy_i].t_name ); +#endif /* defined(__cplusplus) && defined(_CPP_IOSTREAMS) */ + } + } +#endif /* YYDEBUG */ + if ( yychar == 0 ) /* reached EOF. quit */ + YYABORT; + yychar = -1; + goto yy_newstate; + } + }/* end if ( yy_n == 0 ) */ + /* + ** reduction by production yy_n + ** put stack tops, etc. so things right after switch + */ +#if YYDEBUG + /* + ** if debugging, print the string that is the user's + ** specification of the reduction which is just about + ** to be done. + */ + if ( yydebug ) +#if defined(__cplusplus) && defined(_CPP_IOSTREAMS) + cout << "Reduce by (" << yy_n << ") \"" << + yyreds[ yy_n ] << "\"\n"; +#else + printf( "Reduce by (%d) \"%s\"\n", + yy_n, yyreds[ yy_n ] ); +#endif /* defined(__cplusplus) && defined(_CPP_IOSTREAMS) */ +#endif + yytmp = yy_n; /* value to switch over */ + yypvt = yy_pv; /* $vars top of value stack */ + /* + ** Look in goto table for next state + ** Sorry about using yy_state here as temporary + ** register variable, but why not, if it works... + ** If yyr2[ yy_n ] doesn't have the low order bit + ** set, then there is no action to be done for + ** this reduction. So, no saving & unsaving of + ** registers done. The only difference between the + ** code just after the if and the body of the if is + ** the goto yy_stack in the body. This way the test + ** can be made before the choice of what to do is needed. + */ + { + /* length of production doubled with extra bit */ + register int yy_len = yyr2[ yy_n ]; + + if ( !( yy_len & 01 ) ) + { + yy_len >>= 1; + yyval = ( yy_pv -= yy_len )[1]; /* $$ = $1 */ + yy_state = yypgo[ yy_n = yyr1[ yy_n ] ] + + *( yy_ps -= yy_len ) + 1; + if ( yy_state >= YYLAST || + yychk[ yy_state = + yyact[ yy_state ] ] != -yy_n ) + { + yy_state = yyact[ yypgo[ yy_n ] ]; + } + goto yy_stack; + } + yy_len >>= 1; + yyval = ( yy_pv -= yy_len )[1]; /* $$ = $1 */ + yy_state = yypgo[ yy_n = yyr1[ yy_n ] ] + + *( yy_ps -= yy_len ) + 1; + if ( yy_state >= YYLAST || + yychk[ yy_state = yyact[ yy_state ] ] != -yy_n ) + { + yy_state = yyact[ yypgo[ yy_n ] ]; + } + } + /* save until reenter driver code */ + yystate = yy_state; + yyps = yy_ps; + yypv = yy_pv; + } + /* + ** code supplied by user is placed in this switch + */ + + switch(yytmp){ + +case 1: +# line 115 "kc.y" +{ + SetupTableMan(); + } /*NOTREACHED*/ break; +case 2: +# line 119 "kc.y" +{ + if (verbose==1) { /* Printing status report */ + printf("Species used (*=dyn. var.):\n"); + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) + printf(" *%s(", name); + else + printf(" %s(", name); + if (charge==FLT_MAX) + printf("."); + else { + if (charge>0.0) + printf("%d+", (int)charge); + else if (charge<0.0) + printf("%d-", -(int)charge); + } /* else */ + printf(")\n"); + } /* for i*/ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + printf(" *%s\n", name); + } /* for i */ + if (NumOfParameter()!=0) { + printf("Parameters declared:\n"); + for(i=1; i<=NumOfParameter(); i++) { + GetParamNo(i, name, &charge, &side); /* abuse of side */ + if (charge==0.0) + printf(" %s\n", name); + else { + if (side==1) + printf(" %s\n", name); + else { + printf(" %s(", name); + if (charge==FLT_MAX) + printf("."); + else { + if (charge>0.0) + printf("%d+", (int)charge); + else if (charge<0.0) + printf("%d-", -(int)charge); + } /* else */ + printf(")\n"); + } /* else */ + } /* else */ + } /* for i */ + } /* if */ + printf("Constants declared:\n"); + for(i=1; i<=NumOfConstants(); i++) { + GetConstantNo(i, name); + printf(" %s = %e\n", name, GetConstant(name)); + } /* for i */ + for(i=1; i<=NumOfStrConst(); i++) { + GetStrConstNo(i, name, string); + printf(" %s = \"%s\"\n", name, string); + } /* for i */ + } /* if */ + if (IsNonAutoSystem()==1) { + NewDynVar("time"); + tmp=TreeCreate(); + TreeAssignConst(tmp, 1.0); + NewExpr("time", tmp); + TreeKill(tmp); + } /* if */ + } /*NOTREACHED*/ break; +case 8: +# line 190 "kc.y" +{ if (yypvt[-0].strnum.flag==1) + NewConstant(yypvt[-2].name, yypvt[-0].strnum.numb); + else { + NewStrConst(yypvt[-2].name, yypvt[-0].strnum.name); + } + } /*NOTREACHED*/ break; +case 9: +# line 197 "kc.y" +{ temp=TreeEval(yypvt[-1].tree); + if (TreeGetError()==NoEval) + fprintf(stderr, "Unable to evaluate expression in line %d.\n", lineno); + else { + yyval.strnum.flag=1; + yyval.strnum.numb=temp; + } + TreeKill(yypvt[-1].tree); + } /*NOTREACHED*/ break; +case 10: +# line 207 "kc.y" +{ yyval.strnum.flag=2; + strcpy(yyval.strnum.name, yypvt[-2].name); + } /*NOTREACHED*/ break; +case 13: +# line 213 "kc.y" +{ NewPrintVar(yypvt[-0].name); } /*NOTREACHED*/ break; +case 14: +# line 215 "kc.y" +{ NewPrintConc(yypvt[-0].comp.name, yypvt[-0].comp.charge); } /*NOTREACHED*/ break; +case 16: +# line 218 "kc.y" +{ temp=TreeEval(yypvt[-10].tree); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n", lineno); + else { + NewParameter(yypvt[-12].name, temp); + } + TreeKill(yypvt[-10].tree); + temp=TreeEval(yypvt[-8].tree); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n", lineno); + else + NewDeltaParam(yypvt[-12].name, temp); + TreeKill(yypvt[-8].tree); + temp1=TreeEval(yypvt[-6].tree); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n" , lineno); + TreeKill(yypvt[-6].tree); + temp2=TreeEval(yypvt[-2].tree); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n" , lineno); + TreeKill(yypvt[-2].tree); + NewLowHighPrefParam(yypvt[-12].name, temp, temp1, temp2); + temp=TreeEval(yypvt[-0].tree); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n", lineno); + TreeKill(yypvt[-0].tree); + NewDirectForParam(yypvt[-12].name, (int)temp); + temp=TreeEval(yypvt[-4].tree); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n", lineno); + TreeKill(yypvt[-4].tree); + NewDeltaParam(yypvt[-12].name, temp); + } /*NOTREACHED*/ break; +case 17: +# line 252 "kc.y" +{ temp=TreeEval(yypvt[-10].tree); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %\n", lineno); + else + NewParamConc(yypvt[-12].comp.name, yypvt[-12].comp.charge, temp); + temp=TreeEval(yypvt[-8].tree); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %\n", lineno); + TreeKill(yypvt[-10].tree); + TreeKill(yypvt[-8].tree); + temp1=TreeEval(yypvt[-6].tree); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n" , lineno); + TreeKill(yypvt[-6].tree); + temp2=TreeEval(yypvt[-2].tree); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n" , lineno); + TreeKill(yypvt[-2].tree); + NewLowHighPrefConc(yypvt[-12].comp.name, yypvt[-12].comp.charge, temp, temp1, temp2); + temp=TreeEval(yypvt[-0].tree); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n", lineno); + TreeKill(yypvt[-4].tree); + NewDirectForConc(yypvt[-12].comp.name, yypvt[-12].comp.charge, (int)temp); + temp=TreeEval(yypvt[-4].tree); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n", lineno); + TreeKill(yypvt[-4].tree); + NewDeltaConc(yypvt[-12].comp.name, yypvt[-12].comp.charge, temp); + } /*NOTREACHED*/ break; +case 20: +# line 285 "kc.y" +{ NewReaction((int)value); + side=1; + } /*NOTREACHED*/ break; +case 21: +# line 289 "kc.y" +{ + switch (yypvt[-0].flag) { + case '>': + AddReactionKind(GetCurrentReaction(), uni); + break; + case '<': + AddReactionKind(GetCurrentReaction(), bi); + break; + case '=': + AddReactionKind(GetCurrentReaction(), equi); + break; + }; /* switch */ + side=-1; + } /*NOTREACHED*/ break; +case 23: +# line 305 "kc.y" +{ NewExpr(yypvt[-4].name, yypvt[-1].tree); + NewDynVar(yypvt[-4].name); + TreeKill(yypvt[-1].tree); + } /*NOTREACHED*/ break; +case 28: +# line 314 "kc.y" +{ if (strcmp(yypvt[-5].name, "c")!=0) + fprintf(stderr, "c expected!\n"); + else { + temp=TreeEval(yypvt[-0].tree); + if (TreeGetError()==NoEval) + fprintf(stderr, "Unable to evaluate expression in line %d.\n", lineno); + else + NewPowerConst(GetCurrentReaction(), yypvt[-3].comp.name, yypvt[-3].comp.charge, temp, side); + }; /* else */ + TreeKill(yypvt[-0].tree); + } /*NOTREACHED*/ break; +case 29: +# line 326 "kc.y" +{ if (strcmp(yypvt[-2].name, "k")==0) { + NewRateConst(GetCurrentReaction(), -1, yypvt[-0].tree); + } /* if */ + else + if (strcmp(yypvt[-2].name, "v")==0) + NewRateExpr(GetCurrentReaction(), -1, yypvt[-0].tree); + else + fprintf(stderr, "Syntax error: v or k expected in line %d.\n", lineno); + TreeKill(yypvt[-0].tree); + } /*NOTREACHED*/ break; +case 31: +# line 338 "kc.y" +{ if (strcmp(yypvt[-2].name, "K")!=0) + fprintf(stderr, "Syntax error: K expected in line %d.\n", lineno); + else { + NewRateConst(GetCurrentReaction(), 0, yypvt[-0].tree); + }; /* else */ + TreeKill(yypvt[-0].tree); + } /*NOTREACHED*/ break; +case 32: +# line 345 "kc.y" +{ if (GetReactKind(GetCurrentReaction())==bi) (void) fprintf(stderr, "The reaction in line %d is two-ways.\n", lineno); + } /*NOTREACHED*/ break; +case 33: +# line 348 "kc.y" +{ if (GetReactKind(GetCurrentReaction())!=bi) + (void) fprintf(stderr, "The reaction in line %d is a >one-way< reaction or >equilibrium.<\n", lineno); + else { + if (strcmp(yypvt[-3].name, "k")==0) + NewRateConst(GetCurrentReaction(), 1, yypvt[-1].tree); + else + if (strcmp(yypvt[-3].name, "v")==0) + NewRateExpr(GetCurrentReaction(), 1, yypvt[-1].tree); + else + fprintf(stderr, "Syntax error: v or k expected in line %d.\n", lineno); + }; /* else */ + TreeKill(yypvt[-1].tree); + } /*NOTREACHED*/ break; +case 34: +# line 361 "kc.y" +{ yyval.flag='>'; } /*NOTREACHED*/ break; +case 35: +# line 362 "kc.y" +{ yyval.flag='<'; } /*NOTREACHED*/ break; +case 36: +# line 363 "kc.y" +{ yyval.flag='='; } /*NOTREACHED*/ break; +case 37: +# line 365 "kc.y" +{ SpecieInReaction(GetCurrentReaction(), yypvt[-0].comp.name, yypvt[-0].comp.charge); + NewCoeff(GetCurrentReaction(), yypvt[-0].comp.name, yypvt[-0].comp.charge, yypvt[-1].dval, side); + NewSpecie(yypvt[-0].comp.name, yypvt[-0].comp.charge); + } /*NOTREACHED*/ break; +case 38: +# line 370 "kc.y" +{ SpecieInReaction(GetCurrentReaction(), yypvt[-0].comp.name, yypvt[-0].comp.charge); + NewCoeff(GetCurrentReaction(), yypvt[-0].comp.name, yypvt[-0].comp.charge, yypvt[-1].dval, side); + NewSpecie(yypvt[-0].comp.name, yypvt[-0].comp.charge); + } /*NOTREACHED*/ break; +case 39: +# line 375 "kc.y" +{ + (void) strcpy(yyval.comp.name, yypvt[-1].name); + yyval.comp.charge=yypvt[-0].dval; + yyval.comp.concs=no; + } /*NOTREACHED*/ break; +case 40: +# line 381 "kc.y" +{ yyval.dval=yypvt[-1].dval; } /*NOTREACHED*/ break; +case 41: +# line 382 "kc.y" +{ + yyval.dval=0.0; + } /*NOTREACHED*/ break; +case 42: +# line 386 "kc.y" +{ charge=FLT_MAX; + yyval.dval=FLT_MAX; + } /*NOTREACHED*/ break; +case 43: +# line 390 "kc.y" +{ if (yypvt[-1].oper=='+') { + yyval.dval=yypvt[-0].dval; + charge=yypvt[-0].dval; + } /* if */ + else { + charge=-yypvt[-0].dval; + yyval.dval=-yypvt[-0].dval; + }; /* else */ + } /*NOTREACHED*/ break; +case 44: +# line 400 "kc.y" +{ if (yypvt[-0].oper=='+') + yyval.dval=1.0; + else + yyval.dval=-1.0; + } /*NOTREACHED*/ break; +case 45: +# line 405 "kc.y" +{ yyval.oper = '+'; } /*NOTREACHED*/ break; +case 46: +# line 406 "kc.y" +{ yyval.oper = '-'; } /*NOTREACHED*/ break; +case 47: +# line 408 "kc.y" +{ coeff=value; + yyval.dval=yypvt[-0].dval; + } /*NOTREACHED*/ break; +case 48: +# line 412 "kc.y" +{ coeff=1.0; + yyval.dval=1.0; + } /*NOTREACHED*/ break; +case 51: +# line 418 "kc.y" +{ temp=TreeEval(yypvt[-1].tree); + switch (yypvt[-3].flag) { + case 1: + if (TreeGetError()==NoEval) + fprintf(stderr, "Unable to evaluate expression.\n"); + else + NewBeginConc(yypvt[-4].comp.name, yypvt[-4].comp.charge, temp); + break; + case 0: + NewConstraint(yypvt[-4].comp.name, yypvt[-4].comp.charge, yypvt[-1].tree); + break; + }; + TreeKill(yypvt[-1].tree); + } /*NOTREACHED*/ break; +case 52: +# line 433 "kc.y" +{ temp=TreeEval(yypvt[-1].tree); + NewSpecConst(yypvt[-4].comp.name, yypvt[-4].comp.charge, yypvt[-6].name, temp); + if (GetError()==NotFound) + if (yypvt[-4].comp.charge==0.0) + NewDynVarConst(yypvt[-4].comp.name, yypvt[-6].name, temp); + TreeKill(yypvt[-1].tree); + } /*NOTREACHED*/ break; +case 53: +# line 441 "kc.y" +{ temp=TreeEval(yypvt[-1].tree); + if (TreeGetError()==NoEval) + yyerror("Unable to evaluate expression"); + else { + if (yypvt[-3].flag==1) { + NewInitValue(yypvt[-4].name, temp); + TreeKill(yypvt[-1].tree); + } else + yyerror("(0) expected"); + } + } /*NOTREACHED*/ break; +case 54: +# line 453 "kc.y" +{ yyval.tree=TreeCreate(); + TreeCpy(yyval.tree, yypvt[-0].tree); + TreeSign(yyval.tree); + TreeKill(yypvt[-0].tree); + } /*NOTREACHED*/ break; +case 55: +# line 459 "kc.y" +{ yyval.tree=TreeCreate(); + TreeAdd(yypvt[-2].tree, yypvt[-0].tree); + TreeCpy(yyval.tree, yypvt[-2].tree); + TreeKill(yypvt[-0].tree); + TreeKill(yypvt[-2].tree); + } /*NOTREACHED*/ break; +case 56: +# line 466 "kc.y" +{ yyval.tree=TreeCreate(); + TreeSub(yypvt[-2].tree, yypvt[-0].tree); + TreeCpy(yyval.tree, yypvt[-2].tree); + TreeKill(yypvt[-0].tree); + TreeKill(yypvt[-2].tree); + } /*NOTREACHED*/ break; +case 57: +# line 473 "kc.y" +{ + yyval.tree=TreeCreate(); + TreeMul(yypvt[-2].tree, yypvt[-0].tree); + TreeCpy(yyval.tree, yypvt[-2].tree); + TreeKill(yypvt[-2].tree); + TreeKill(yypvt[-0].tree); + } /*NOTREACHED*/ break; +case 58: +# line 481 "kc.y" +{ + yyval.tree=TreeCreate(); + TreeDiv(yypvt[-2].tree, yypvt[-0].tree); + TreeCpy(yyval.tree, yypvt[-2].tree); + TreeKill(yypvt[-2].tree); + TreeKill(yypvt[-0].tree); + } /*NOTREACHED*/ break; +case 59: +# line 489 "kc.y" +{ yyval.tree=TreeCreate(); + TreeCpy(yyval.tree, yypvt[-2].tree); + TreePow(yyval.tree, yypvt[-0].tree); + TreeKill(yypvt[-2].tree); + TreeKill(yypvt[-0].tree); + } /*NOTREACHED*/ break; +case 60: +# line 496 "kc.y" +{ yyval.tree=TreeCreate(); + TreeCpy(yyval.tree, yypvt[-1].tree); + TreeKill(yypvt[-1].tree); + } /*NOTREACHED*/ break; +case 61: +# line 501 "kc.y" +{ + yyval.tree=TreeCreate(); + temp=GetConstant(yypvt[-0].name); + if (GetError()==NotFound) { + TreeAssignVar(yyval.tree, yypvt[-0].name); + if (strcmp(yypvt[-0].name, "time")==0) + NonAutoSystem(); + } else + TreeAssignConst(yyval.tree, temp); + } /*NOTREACHED*/ break; +case 62: +# line 512 "kc.y" +{ yyval.tree=TreeCreate(); + TreeAssignConst(yyval.tree, yypvt[-0].dval); + } /*NOTREACHED*/ break; +case 63: +# line 516 "kc.y" +{ + yyval.tree=TreeCreate(); + if (yypvt[-0].flag==1) { + temp=GetBeginConc(yypvt[-1].comp.name, yypvt[-1].comp.charge); + if (GetError()==NoError) + TreeAssignConst(yyval.tree, temp); + else + fprintf(stderr, "[%s(%e)] not found.\n", yypvt[-1].comp.name, yypvt[-1].comp.charge); + flag='1'; + } /* if */ + else { + flag='0'; + RenameSpec(name, yypvt[-1].comp.name, yypvt[-1].comp.charge); + TreeAssignVar(yyval.tree, name); + }; /* else */ + } /*NOTREACHED*/ break; +case 64: +# line 533 "kc.y" +{ yyval.tree=TreeCreate(); + TreeCpy(yyval.tree, yypvt[-1].tree); + TreeApplyFunc(&yyval.tree, yypvt[-3].func); + TreeKill(yypvt[-1].tree); + } /*NOTREACHED*/ break; +case 65: +# line 538 "kc.y" +{ yyval.func=Exp; } /*NOTREACHED*/ break; +case 66: +# line 539 "kc.y" +{ yyval.func=Ln; } /*NOTREACHED*/ break; +case 67: +# line 540 "kc.y" +{ yyval.func=Log; } /*NOTREACHED*/ break; +case 68: +# line 541 "kc.y" +{ yyval.func=Sin; } /*NOTREACHED*/ break; +case 69: +# line 542 "kc.y" +{ yyval.func=Cos; } /*NOTREACHED*/ break; +case 70: +# line 543 "kc.y" +{ yyval.func=Tan; } /*NOTREACHED*/ break; +case 71: +# line 544 "kc.y" +{ yyval.func=Sinh; } /*NOTREACHED*/ break; +case 72: +# line 545 "kc.y" +{ yyval.func=Cosh; } /*NOTREACHED*/ break; +case 73: +# line 546 "kc.y" +{ yyval.func=Tanh; } /*NOTREACHED*/ break; +case 74: +# line 547 "kc.y" +{ yyval.func=Asin; } /*NOTREACHED*/ break; +case 75: +# line 548 "kc.y" +{ yyval.func=Acos; } /*NOTREACHED*/ break; +case 76: +# line 549 "kc.y" +{ yyval.func=Atan; } /*NOTREACHED*/ break; +case 77: +# line 550 "kc.y" +{ yyval.func=Asinh; } /*NOTREACHED*/ break; +case 78: +# line 551 "kc.y" +{ yyval.func=Acosh; } /*NOTREACHED*/ break; +case 79: +# line 552 "kc.y" +{ yyval.func=Atanh; } /*NOTREACHED*/ break; +case 80: +# line 554 "kc.y" +{ + (void) strcpy(yyval.comp.name, yypvt[-1].comp.name); + yyval.comp.charge=yypvt[-1].comp.charge; + yyval.comp.concs=ord; + } /*NOTREACHED*/ break; +case 81: +# line 559 "kc.y" +{ yyval.flag=0; } /*NOTREACHED*/ break; +case 82: +# line 561 "kc.y" +{ yyval.flag=1; } /*NOTREACHED*/ break; +} + + + goto yystack; /* reset registers in driver code */ +} + +# line 562 "kc.y" + +#include "lex.c" diff --git a/src/kc.l b/src/kc.l new file mode 100644 index 0000000..bfe2c88 --- /dev/null +++ b/src/kc.l @@ -0,0 +1,112 @@ +Digit [0-9] +Letter [A-Za-z] +Sign "-"|"+" +alphabet ({Digit}|{Letter}) +%% +[ \t] ; +\n lineno++; +"/*" { CommentC(); } +"(*" { CommentPas(); } + +"exp" return fun_exp; +"log" return fun_log; +"ln" return fun_ln; +"sin" return fun_sin; +"cos" return fun_cos; +"tan" return fun_tan; +"sinh" return fun_sinh; +"cosh" return fun_cosh; +"tanh" return fun_tanh; +"asin" return fun_asin; +"acos" return fun_acos; +"atan" return fun_atan; +"asinh" return fun_asinh; +"acosh" return fun_acosh; +"atanh" return fun_atanh; + +(({Digit}+)|({Digit}*\.{Digit}+)([eELl][-+]?{Digit}+)?) { num(); yylval.dval=value; return numbers; } +{Letter}({Digit}|{Letter})* { (void) strcpy(yylval.name, yytext); return names; } +"#parameter" return param; +"#print" return print; +"'" return prime; +"(" return leftpar; +")" return rightpar; +"(0)" return time0; +"->" return oneway; +"<->" return twoways; +"<=>" return twoways; +"=" return equal; +"." return radical; +"k>" { strcpy(yylval.name, "k"); return leftarr; } +"k<" { strcpy(yylval.name, "k"); return rightarr; } +"v>" { strcpy(yylval.name, "v"); return leftarr; } +"v<" { strcpy(yylval.name, "v"); return rightarr; } +"K" return K; +"+" return plus; +"-" return minus; +"**" return powop; +"^" return powop; +"*" return multi; +"/" return pdiv; +"[" return leftconc; +"]" return rightconc; +"," return comma; +";" return semicolon; +":" return colon; +"\"" return quotation; + +%% +CommentC() +{ char c; + int finished; + + finished=0; + while (finished==0) { + while (input()!='*') /* nothing */; + if ((c=input())=='/') finished=1; + } /* while */ +} /* Comment */ + +CommentPas() +{ char c; + int finished; + + finished=0; + while (finished==0) { + while (input()!='*') /* nothing */; + if ((c=input())==')') finished=1; + } /* while */ +} /* Comment */ + + +incl() { + + int i, start; + + i=8; + while (yytext[i]==' ') i++; + start=i; + while (yytext[i]!='\0') { yytext[i-start]=yytext[i]; i++; } + yytext[i]='\0'; +} /* incl */ + +num() { + + float temp; + int i; + + for(i=0; i +#include +#include +#include "symbmath.h" +#include "tableman.h" +#include "codecall.h" + +typedef enum {no, ini, ord} Conc; + +typedef struct compound { + char name[STRING_LENGTH]; + double charge; + Conc concs; +} compound; + +typedef struct Strnum { + int flag; + char name[STRING_LENGTH]; + double numb; +} Strnum; + +double coeff, charge, value, temp, temp1, temp2; +char flag, name[STRING_LENGTH], string[STRING_LENGTH]; +int i, j, side, lineno=1; +Tree tmp; +%} + +%union { + double dval; + char oper; + char name[STRING_LENGTH]; + compound comp; + char flag; + Tree tree; + Function func; + Strnum strnum; +} + +%token names +%token leftarr +%token rightarr +%token numbers +%token param +%token print +%token powop +%token semicolon +%token quotation +%token equal +%token colon +%token R +%token E +%token powc +%token leftpar +%token rightpar +%token oneway +%token twoways +%token plus +%token minus +%token multi +%token pdiv +%token comma +%token leftconc +%token rightconc +%token time0 +%token K +%token radical +%token V +%token prime +%token fun_exp +%token fun_log +%token fun_ln +%token fun_sin +%token fun_cos +%token fun_tan +%token fun_sinh +%token fun_cosh +%token fun_tanh +%token fun_asin +%token fun_acos +%token fun_atan +%token fun_asinh +%token fun_acosh +%token fun_atanh +%type expr +%type charge size coeff +%type sign +%type timeopt kind +%type subst conc substs +%type function +%type strnumb +%start system +%left plus minus +%left multi pdiv +%left powop +%nonassoc UMINUS +%% +system : { + SetupTableMan(); + } + declars reactions constants + { + if (verbose==1) { /* Printing status report */ + printf("Species used (*=dyn. var.):\n"); + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) + printf(" *%s(", name); + else + printf(" %s(", name); + if (charge==FLT_MAX) + printf("."); + else { + if (charge>0.0) + printf("%d+", (int)charge); + else if (charge<0.0) + printf("%d-", -(int)charge); + } /* else */ + printf(")\n"); + } /* for i*/ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + printf(" *%s\n", name); + } /* for i */ + if (NumOfParameter()!=0) { + printf("Parameters declared:\n"); + for(i=1; i<=NumOfParameter(); i++) { + GetParamNo(i, name, &charge, &side); /* abuse of side */ + if (charge==0.0) + printf(" %s\n", name); + else { + if (side==1) + printf(" %s\n", name); + else { + printf(" %s(", name); + if (charge==FLT_MAX) + printf("."); + else { + if (charge>0.0) + printf("%d+", (int)charge); + else if (charge<0.0) + printf("%d-", -(int)charge); + } /* else */ + printf(")\n"); + } /* else */ + } /* else */ + } /* for i */ + } /* if */ + printf("Constants declared:\n"); + for(i=1; i<=NumOfConstants(); i++) { + GetConstantNo(i, name); + printf(" %s = %e\n", name, GetConstant(name)); + } /* for i */ + for(i=1; i<=NumOfStrConst(); i++) { + GetStrConstNo(i, name, string); + printf(" %s = \"%s\"\n", name, string); + } /* for i */ + } /* if */ + if (IsNonAutoSystem()==1) { + NewDynVar("time"); + tmp=TreeCreate(); + TreeAssignConst(tmp, 1.0); + NewExpr("time", tmp); + TreeKill(tmp); + } /* if */ + }; +declars : declars declar + | ; +declar : constant + | parameter + | print printlist semicolon; +constant : names equal strnumb + { if ($3.flag==1) + NewConstant($1, $3.numb); + else { + NewStrConst($1, $3.name); + } + }; +strnumb : expr semicolon + { temp=TreeEval($1); + if (TreeGetError()==NoEval) + fprintf(stderr, "Unable to evaluate expression in line %d.\n", lineno); + else { + $$.flag=1; + $$.numb=temp; + } + TreeKill($1); + } + | quotation names quotation semicolon + { $$.flag=2; + strcpy($$.name, $2); + }; +printlist : printlist comma prn_entry + | prn_entry; +prn_entry : names + { NewPrintVar($1); } + | conc + { NewPrintConc($1.name, $1.charge); }; +parameter : param pentry semicolon; +pentry : names equal expr comma expr comma expr comma expr comma expr comma expr + { temp=TreeEval($3); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n", lineno); + else { + NewParameter($1, temp); + } + TreeKill($3); + temp=TreeEval($5); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n", lineno); + else + NewDeltaParam($1, temp); + TreeKill($5); + temp1=TreeEval($7); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n" , lineno); + TreeKill($7); + temp2=TreeEval($11); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n" , lineno); + TreeKill($11); + NewLowHighPrefParam($1, temp, temp1, temp2); + temp=TreeEval($13); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n", lineno); + TreeKill($13); + NewDirectForParam($1, (int)temp); + temp=TreeEval($9); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n", lineno); + TreeKill($9); + NewDeltaParam($1, temp); + } + | conc equal expr comma expr comma expr comma expr comma expr comma expr + { temp=TreeEval($3); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %\n", lineno); + else + NewParamConc($1.name, $1.charge, temp); + temp=TreeEval($5); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %\n", lineno); + TreeKill($3); + TreeKill($5); + temp1=TreeEval($7); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n" , lineno); + TreeKill($7); + temp2=TreeEval($11); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n" , lineno); + TreeKill($11); + NewLowHighPrefConc($1.name, $1.charge, temp, temp1, temp2); + temp=TreeEval($13); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n", lineno); + TreeKill($9); + NewDirectForConc($1.name, $1.charge, (int)temp); + temp=TreeEval($9); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n", lineno); + TreeKill($9); + NewDeltaConc($1.name, $1.charge, temp); + }; +reactions : reaction + | reactions reaction; +reaction : numbers + { NewReaction((int)value); + side=1; + } + colon substs kind + { + switch ($5) { + case '>': + AddReactionKind(GetCurrentReaction(), uni); + break; + case '<': + AddReactionKind(GetCurrentReaction(), bi); + break; + case '=': + AddReactionKind(GetCurrentReaction(), equi); + break; + }; /* switch */ + side=-1; + } + substs semicolon reackonst + | names prime equal expr semicolon + { NewExpr($1, $4); + NewDynVar($1); + TreeKill($4); + }; +reackonst : powconsts semicolon rateconsts + | rateconsts; +powconsts : powconsts semicolon powconst + | powconst; +powconst : names leftpar subst rightpar equal expr + { if (strcmp($1, "c")!=0) + fprintf(stderr, "c expected!\n"); + else { + temp=TreeEval($6); + if (TreeGetError()==NoEval) + fprintf(stderr, "Unable to evaluate expression in line %d.\n", lineno); + else + NewPowerConst(GetCurrentReaction(), $3.name, $3.charge, temp, side); + }; /* else */ + TreeKill($6); + }; +rateconsts: leftarr equal expr + { if (strcmp($1, "k")==0) { + NewRateConst(GetCurrentReaction(), -1, $3); + } /* if */ + else + if (strcmp($1, "v")==0) + NewRateExpr(GetCurrentReaction(), -1, $3); + else + fprintf(stderr, "Syntax error: v or k expected in line %d.\n", lineno); + TreeKill($3); + } + semicolon ropt + | names equal expr + { if (strcmp($1, "K")!=0) + fprintf(stderr, "Syntax error: K expected in line %d.\n", lineno); + else { + NewRateConst(GetCurrentReaction(), 0, $3); + }; /* else */ + TreeKill($3); + }; +ropt : { if (GetReactKind(GetCurrentReaction())==bi) (void) fprintf(stderr, "The reaction in line %d is two-ways.\n", lineno); + } + | rightarr equal expr semicolon + { if (GetReactKind(GetCurrentReaction())!=bi) + (void) fprintf(stderr, "The reaction in line %d is a >one-way< reaction or >equilibrium.<\n", lineno); + else { + if (strcmp($1, "k")==0) + NewRateConst(GetCurrentReaction(), 1, $3); + else + if (strcmp($1, "v")==0) + NewRateExpr(GetCurrentReaction(), 1, $3); + else + fprintf(stderr, "Syntax error: v or k expected in line %d.\n", lineno); + }; /* else */ + TreeKill($3); + }; +kind : oneway { $$='>'; } + | twoways { $$='<'; } + | equal { $$='='; }; +substs : coeff subst + { SpecieInReaction(GetCurrentReaction(), $2.name, $2.charge); + NewCoeff(GetCurrentReaction(), $2.name, $2.charge, $1, side); + NewSpecie($2.name, $2.charge); + } + | substs plus coeff subst + { SpecieInReaction(GetCurrentReaction(), $4.name, $4.charge); + NewCoeff(GetCurrentReaction(), $4.name, $4.charge, $3, side); + NewSpecie($4.name, $4.charge); + }; +subst : names charge + { + (void) strcpy($$.name, $1); + $$.charge=$2; + $$.concs=no; + }; +charge : leftpar size rightpar + { $$=$2; } + | { + $$=0.0; + }; +size : radical + { charge=FLT_MAX; + $$=FLT_MAX; + } + | sign numbers + { if ($1=='+') { + $$=$2; + charge=$2; + } /* if */ + else { + charge=-$2; + $$=-$2; + }; /* else */ + } + | sign + { if ($1=='+') + $$=1.0; + else + $$=-1.0; + }; +sign : plus { $$ = '+'; } + | minus { $$ = '-'; }; +coeff : numbers + { coeff=value; + $$=$1; + } + | + { coeff=1.0; + $$=1.0; + }; +constants : const + | constants const; +const : conc timeopt equal expr semicolon + { temp=TreeEval($4); + switch ($2) { + case 1: + if (TreeGetError()==NoEval) + fprintf(stderr, "Unable to evaluate expression.\n"); + else + NewBeginConc($1.name, $1.charge, temp); + break; + case 0: + NewConstraint($1.name, $1.charge, $4); + break; + }; + TreeKill($4); + } + | names leftpar subst rightpar equal expr semicolon + { temp=TreeEval($6); + NewSpecConst($3.name, $3.charge, $1, temp); + if (GetError()==NotFound) + if ($3.charge==0.0) + NewDynVarConst($3.name, $1, temp); + TreeKill($6); + }; + | names timeopt equal expr semicolon + { temp=TreeEval($4); + if (TreeGetError()==NoEval) + yyerror("Unable to evaluate expression"); + else { + if ($2==1) { + NewInitValue($1, temp); + TreeKill($4); + } else + yyerror("(0) expected"); + } + } +expr : minus expr %prec UMINUS + { $$=TreeCreate(); + TreeCpy($$, $2); + TreeSign($$); + TreeKill($2); + } + | expr plus expr + { $$=TreeCreate(); + TreeAdd($1, $3); + TreeCpy($$, $1); + TreeKill($3); + TreeKill($1); + } + | expr minus expr + { $$=TreeCreate(); + TreeSub($1, $3); + TreeCpy($$, $1); + TreeKill($3); + TreeKill($1); + } + | expr multi expr + { + $$=TreeCreate(); + TreeMul($1, $3); + TreeCpy($$, $1); + TreeKill($1); + TreeKill($3); + } + | expr pdiv expr + { + $$=TreeCreate(); + TreeDiv($1, $3); + TreeCpy($$, $1); + TreeKill($1); + TreeKill($3); + } + | expr powop expr + { $$=TreeCreate(); + TreeCpy($$, $1); + TreePow($$, $3); + TreeKill($1); + TreeKill($3); + } + | leftpar expr rightpar + { $$=TreeCreate(); + TreeCpy($$, $2); + TreeKill($2); + } + | names + { + $$=TreeCreate(); + temp=GetConstant($1); + if (GetError()==NotFound) { + TreeAssignVar($$, $1); + if (strcmp($1, "time")==0) + NonAutoSystem(); + } else + TreeAssignConst($$, temp); + } + | numbers + { $$=TreeCreate(); + TreeAssignConst($$, $1); + } + | conc timeopt + { + $$=TreeCreate(); + if ($2==1) { + temp=GetBeginConc($1.name, $1.charge); + if (GetError()==NoError) + TreeAssignConst($$, temp); + else + fprintf(stderr, "[%s(%e)] not found.\n", $1.name, $1.charge); + flag='1'; + } /* if */ + else { + flag='0'; + RenameSpec(name, $1.name, $1.charge); + TreeAssignVar($$, name); + }; /* else */ + } + | function leftpar expr rightpar + { $$=TreeCreate(); + TreeCpy($$, $3); + TreeApplyFunc(&$$, $1); + TreeKill($3); + }; +function : fun_exp { $$=Exp; } + | fun_ln { $$=Ln; } + | fun_log { $$=Log; } + | fun_sin { $$=Sin; } + | fun_cos { $$=Cos; } + | fun_tan { $$=Tan; } + | fun_sinh { $$=Sinh; } + | fun_cosh { $$=Cosh; } + | fun_tanh { $$=Tanh; } + | fun_asin { $$=Asin; } + | fun_acos { $$=Acos; } + | fun_atan { $$=Atan; } + | fun_asinh { $$=Asinh; } + | fun_acosh { $$=Acosh; } + | fun_atanh { $$=Atanh; }; +conc : leftconc subst rightconc + { + (void) strcpy($$.name, $2.name); + $$.charge=$2.charge; + $$.concs=ord; + }; +timeopt : { $$=0; } + | time0 + { $$=1; }; +%% +#include "lex.c" diff --git a/src/kgode.c b/src/kgode.c new file mode 100644 index 0000000..48a20ad --- /dev/null +++ b/src/kgode.c @@ -0,0 +1,281 @@ +/************************************************************************** + KGode - a code generator for kc and the KGode (now called KKsolver) + package. + + CopyWrong 1993-1995 by + Kenneth Gesshirt (kneth@fatou.ruc.dk) + Department of Life Sciences and Chemistry + Roskilde University + P.O. Box 260 + 4000 Roskilde + Denmark + + See kc.tex for details. + Last updated: 11 May 1995 by KN +***************************************************************************/ + +#include +#include +#include +#include +#include "config.h" +#include "symbmath.h" +#include "tableman.h" +#include "codegen.h" +#include "misc.h" + + +void KGode(FILE* ccode, FILE *hcode) { + + double charge, temp, coeff; + char *name, *rename, *strtmp; + time_t timer; + Tree v_temp, tmp, temp_tree, tree_temp; + int i, j, react_no, finished, constraint, dyn, dyn2; + int ngrid, mgrid, boundary, jj; + + name=StringAlloc(); + rename=StringAlloc(); + strtmp=StringAlloc(); + + InitCodeGenVar(NoOfSpec()+NumOfDynVar()-NumOfConstraint(), + NumOfConstraint(),NoOfReact()); + + timer=time(&timer); + fprintf(hcode, "/*********************************************\n"); + fprintf(hcode, " WARNING: This file was generated by kc v%s\n", VERSION); + fprintf(hcode, " CopyWrong by Kenneth Geisshirt\n"); + fprintf(hcode, " %s", ctime(&timer)); + + fprintf(hcode, "**********************************************/\n"); + fprintf(hcode, "#ifndef _MODEL_HEADER_\n#define _MODEL_HEADER_\n"); + fprintf(ccode, "/*********************************************\n"); + fprintf(ccode, " WARNING: This file was generated by kc v%s\n", VERSION); + fprintf(ccode, " CopyWrong by Kenneth Geisshirt\n"); + fprintf(ccode, " %s", ctime(&timer)); + fprintf(ccode, "**********************************************/\n"); + fprintf(ccode, "#include \"model.h\"\n"); + fprintf(ccode, "#include \n"); + i=NoOfSpec()+NumOfDynVar()-NumOfConstraint(); + fprintf(hcode, "#define equa %d\n", i); + temp=GetConstant("mode"); + if (GetError()==NotFound) + temp=0.0; + switch ((int)temp) { + case 0: /* normal sim */ + fprintf(hcode, "#undef _DO_PERT_\n"); + break; + case 1: /* perturbation */ + fprintf(hcode, "#define _DO_PERT_\n"); + break; + } + + temp=GetConstant("screen"); + if (GetError()==NotFound) + temp=0.0; + if (temp==1.0) + fprintf(hcode, "#define PRINT_ON_SCREEN\n"); + else + fprintf(hcode, "#undef PRINT_ON_SCREEN\n"); + + fprintf(hcode, "double x_[equa],x_pert[equa],xscal_[equa];\n"); + fprintf(hcode, "int do_print[equa];\n"); + fprintf(hcode, "char species[equa][25];\n"); + + GenerateRateExpr(); + GenerateJacobi(); + + fprintf(ccode, "void reac(double* S_, double* v_) {\n"); + fprintf(hcode, "extern void reac(double *, double *);\n"); + fprintf(ccode, "int j_;\n"); + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) { + RenameSpec(rename, name, charge); + fprintf(ccode, "double %s;\n", rename); + } /* if */ + } /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(ccode, "double %s;\n", name); + } /* for i */ + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + RenameSpec(rename, name, charge); + constraint=IsSpecInConstraint(name, charge); + if (constraint==0) { + fprintf(ccode, "%s=S_[%d];\n", rename, dyn-1); + dyn++; + } /* if */ + } /* for i*/ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(ccode, "%s=S_[%d];\n", name, i+NoOfSpec()-NumOfConstraint()-1); + } /* for i */ + dyn=0; + for(i=1; i<=(NoOfSpec()+NumOfDynVar()-NumOfConstraint()); i++) { + fprintf(ccode, "v_[%d]=(", i-1); + TreePrint(v[i-1], 3, ccode); + fprintf(ccode, ");\n"); + } /* for i */ + fprintf(ccode, "}\n"); + + /* Printing Jacobi matrix routine */ + + fprintf(ccode, "void jacobi(double *S_){\n"); + fprintf(hcode, "extern void jacobi(double *);\n"); + fprintf(ccode, "int j_;\n"); + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) { + RenameSpec(rename, name, charge); + fprintf(ccode, "double %s;\n", rename); + } /* if */ + } /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(ccode, "double %s;\n", name); + } /* for i */ + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + RenameSpec(rename, name, charge); + constraint=IsSpecInConstraint(name, charge); + if (constraint==0) { + fprintf(ccode, "%s=S_[%d];\n", rename, dyn-1); + dyn++; + } /* if */ + } /* for i*/ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(ccode, "%s=S_[%d];\n", name, i+NoOfSpec()-NumOfConstraint()-1); + } /* for i */ + for(i=0; i +#include +#include +#include +#include "config.h" +#include "symbmath.h" +#include "tableman.h" +#include "codegen.h" +#include "misc.h" + +void KnCont(FILE *pcode, FILE *hcode) { + + double charge, temp, coeff, temp1, temp2; + char *name, *rename; + time_t timer; + Tree v_temp, tmp, temp_tree, tmp2; + int i, j, k, l, react_no, finished, constraint, dyn, dyn2, dyn3, form; + int NumbOfParams, NumbOfDynVars; + int need_dd_jac, BfErrorCode; + + name=StringAlloc(); + rename=StringAlloc(); + timer=time(&timer); + NumbOfParams=NumOfParameter(); + NumbOfDynVars=NoOfSpec()-NumOfConstraint()+NumOfDynVar(); + if ((NumbOfParams==0) || (NumbOfParams>2)) { + fprintf(stderr, "KNCont: Wrong number of parameters - should be either 1 or 2.\n"); + return; + } /* if */ + + InitCodeGenVar(NoOfSpec()+NumOfDynVar()-NumOfConstraint(), + NumOfConstraint(), NoOfReact()); + GenerateRateExpr(); + GenerateJacobi(); + if (NumbOfParams==2) { + GenerateHessian(); + } /* if */ + + fprintf(hcode, "(******************************************************\n"); + fprintf(hcode, " WARNING: This file was generated by kc v%s\n", + VERSION); + fprintf(hcode, " CopyWrong 1994 by Kenneth Geisshirt.\n"); + fprintf(hcode, " %s", ctime(&timer)); + fprintf(hcode, "*******************************************************)\n"); + fprintf(hcode, "CONST\n"); + fprintf(hcode, "n=%d;\n", NumbOfDynVars); + fprintf(hcode, "np=%d;\n", NumbOfDynVars); + fprintf(hcode, "VAR\n"); + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + RenameSpec(rename, name, charge); + fprintf(hcode, "%s:LONGREAL;\n", rename); + } /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(hcode, "%s:LONGREAL;\n", name); + } /* for i */ + for(i=1; i<=NumOfParameter(); i++) { + GetParamNo(i, name, &charge, &form); + if (form==1) + strcpy(rename, name); + else + RenameSpec(rename, name, charge); + fprintf(hcode, "%s:LONGREAL;\n", rename); + } /* for i */ + fprintf(hcode, "species : ARRAY[1..n] OF STRING[20];\n"); + + fprintf(pcode, "(******************************************************\n"); + fprintf(pcode, " WARNING: This file was generated by kc v%s\n", + VERSION); + fprintf(pcode, " CopyWrong 1994 by Kenneth Geisshirt.\n"); + fprintf(pcode, " %s", ctime(&timer)); + fprintf(pcode, "*******************************************************)\n"); + + /* printing Hessian */ + fprintf(pcode, "PROCEDURE djacobian(xx_:glnarray; VAR dS_:gldjacobian);\n"); + fprintf(pcode, "BEGIN\n"); + switch (NumbOfParams) { + case 1: + need_dd_jac=0; + break; + case 2: + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if ((IsSpecInConstraint(name, charge)==0) && + (IsSpecParam(name, charge)!=1)) { + RenameSpec(rename, name, charge); + fprintf(pcode, "%s:=xx_[%d];\n", rename, dyn); + dyn++; + } /* if */ + } /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(pcode, "%s:=xx_[%d];\n", rename, + i+NoOfSpec()/NumOfConstraint()); + } /* for i */ + need_dd_jac=0; + +/* + for(i=0; i0) { + fprintf(pcode, "%s:=", rename); + TreePrint(con[constraint-1], 2, pcode); + fprintf(pcode, ";\n"); + }; /* if */ + }; /* for i */ + + for(i=1; i<=NumbOfDynVars; i++) { + fprintf(pcode, "vv_[%d]:=", i); + TreePrint(v[i-1], 2, pcode); + fprintf(pcode, ";\n"); + } /* for i */ + fprintf(pcode, "IF bj_ THEN BEGIN\n"); + + for(i=1; i<=NumbOfDynVars; i++) { + for(j=1; j<=NumbOfDynVars; j++) { + temp=TreeEval(jacobi[i-1][j-1]); + if (TreeGetError()==NoEval) { + fprintf(pcode, "jj_[%d, %d]:=", i, j); + TreePrint(jacobi[i-1][j-1], 2, pcode); + fprintf(pcode, ";\n"); + } /* if */ + } /* for j */ + } /* for i */ + fprintf(pcode, "END;\nEND; (* derivs *)\n\n"); + + /* End of printing derivs */ + + + /* Printing derivsinit */ + + fprintf(pcode, "PROCEDURE derivsinit;\n"); + fprintf(pcode, "BEGIN\n"); + + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) { + RenameSpec(rename, name, charge); + fprintf(pcode, "species[%d]:='%s';\n", dyn, rename); + dyn++; + } /* if */ + } /* for i */ + + /* maaske skal foelgende benyttes istedet for det naeste */ + /* for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(pcode, "species[%d]:='%s';\n", + i+NoOfSpec()-NumOfConstraint()-IsNotAutoSystem()-1, name); + }*/ /* for i */ + + /* maaske foelgende godt nok */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(pcode, "species[%d]:='%s';\n", i+NoOfSpec(), name); + }; /* for i */ + + GetAndPrintConst("epsr", "epsr", 1, 1e-3, pcode, 2); + GetAndPrintConst("epsa", "epsa", 1, 1e-20, pcode, 2); + GetStrConst("datafile", name); + if (GetError()==NotFound) + fprintf(pcode, "name_datafile:='kinwrkdat';\n"); + else + fprintf(pcode, "name_datafile:='%s';\n", name); + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) { + temp=GetBeginConc(name, charge); + fprintf(pcode, "xx[%d]:=%e;\n", dyn, temp); + dyn++; + } /* if */ + } /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(pcode, "xx[%d]:=%e;\n", i+NoOfSpec()-NumOfConstraint(), + GetInitValue(name)); + } /* for i */ + + /* constant elements of the Jacobian matrix */ + for(i=1; i<=NumbOfDynVars; i++) { + for(j=1; j<=NumbOfDynVars; j++) { + temp=TreeEval(jacobi[i-1][j-1]); + if (TreeGetError()==TreeNoError) { + fprintf(pcode, "jacobi[%d, %d]:= %e;\n", i, j, temp); + } /* if */ + } /* for j */ + } /* for i */ + + fprintf(pcode, "END; (* derivs *)\n\n"); + + /* End of printing derivsinit */ + + /* NumbOfParams: 1 - sp_dalfa and derpinit are printed, 2 - hf_dalfa and hopfinit are printed */ + + switch (NumbOfParams) { + case 1: + /* Printing sp_dalfa */ + fprintf(pcode, "PROCEDURE sp_dalfa(bj_: BOOLEAN;xx_: glnarray; VAR gg_: glnpbynp);\n"); + fprintf(pcode, "BEGIN\n"); + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if ((IsSpecInConstraint(name, charge)==0) && + (IsSpecParam(name, charge)!=1)) { + RenameSpec(rename, name, charge); + fprintf(pcode, "%s:=xx_[%d];\n", rename, dyn); + dyn++; + } /* if */ + } /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(pcode, "%s:=xx_[%d];\n", name, i+NoOfSpec()-NumOfConstraint()); + } /* for i */ + + GetParamNo(1, name, &charge, &form); + if (form==2) + RenameSpec(rename, name, charge); + else + strcpy(rename, name); + fprintf(pcode, "%s:=xx_[n1];\n", rename); + fprintf(pcode, "IF bj_ THEN\nBEGIN\n"); + GetParamNo(1, name, &charge, &form); + if (form==1) + strcpy(rename, name); + else + RenameSpec(rename, name, charge); + for(j=0; j0.0) + fprintf(pcode, "initndir[%d]:=1;\n", dyn); + else + fprintf(pcode, "initndir[%d]:=-1;\n", dyn); + fprintf(pcode, "inithmax[%d]:=%e;\n", dyn, fabs(temp)); + } /* if */ + } /* else */ + + temp=GetSpecConst(name, charge, "Bfxmax"); + BfErrorCode= GetError(); + if (BfErrorCode==NotFound) { + fprintf(pcode, "initxupp[%d]:=%e;\n", dyn, 1.0E3); + } else { + if (BfErrorCode==NoError) { + fprintf(pcode, "initxupp[%d]:=%e;\n", dyn, temp); + } /* if */ + } /* else */ + + temp=GetSpecConst(name, charge, "Bfxmin"); + BfErrorCode= GetError(); + if (BfErrorCode==NotFound) { + fprintf(pcode, "initxlow[%d]:=%e;\n", dyn, 0.0); + } else { + if (BfErrorCode==NoError) { + fprintf(pcode, "initxlow[%d]:=%e;\n", dyn, temp); + } /* if */ + } /* else */ + + temp=GetSpecConst(name, charge, "Bfpref"); + BfErrorCode= GetError(); + if (BfErrorCode==NotFound) { + fprintf(pcode, "initpref[%d]:=%e;\n", dyn, 0.1); + } else { + if (BfErrorCode==NoError) { + fprintf(pcode, "initpref[%d]:=%e;\n", dyn, temp); + } /* if */ + } /* else */ + + + } /* if */ + } /* for i */ + + for(i=1; i<=NumOfParameter(); i++) { + GetParamNo(i, name, &charge, &form); + if (form==1) { + GetInitParam(name, &temp); + fprintf(pcode, "xx[n%d]:=%e;\n", i, temp); + temp=GetDirectForParam(name); + if (temp>0.0) + fprintf(pcode, "initndir[n%d]:=1;\n", i); + else + fprintf(pcode, "initndir[n%d]:=-1;\n", i); + GetDeltaParam(name, &temp); + fprintf(pcode, "inithmax[n%d]:=%e;\n", i, fabs(temp)); + GetLowHighPrefParam(name, &temp, &temp1, &temp2); + fprintf(pcode, "initxlow[n%d]:=%e;\n", i, temp); + fprintf(pcode, "initxupp[n%d]:=%e;\n", i, temp1); + if ((temp2>1.0) && (temp2<0.0)) + fprintf(pcode, "KnCont: Pref. for %s must between 0 and 1.\n", name); + else + fprintf(pcode, "initpref[n%d]:=%e;\n", i, temp2); + } /* if */ + else { + GetInitConc(name, charge, &temp); + fprintf(pcode, "xx[n%d]:=%e;\n", i, temp); + temp=GetDirectForConc(name, charge); + if (temp>0.0) + fprintf(pcode, "initndir[n%d]:=1;\n", i); + else + fprintf(pcode, "initndir[n%d]:=-1;\n", i); + GetDeltaConc(name, charge, &temp); + fprintf(pcode, "inithmax[n%d]:=%e;\n", i, fabs(temp)); + GetLowHighPrefConc(name, charge, &temp, &temp1, &temp2); + fprintf(pcode, "initxlow[n%d]:=%e;\n", i, temp); + fprintf(pcode, "initxupp[n%d]:=%e;\n", i, temp1); + if ((temp2>1.0) && (temp2<0.0)) + fprintf(pcode, "KnCont: Pref. for %s(%d) must between 0 and 1.\n", + name, (int)charge); + else + fprintf(pcode, "initpref[n%d]:=%e;\n", i, temp2); + } /* else */ + } /* for i */ + fprintf(pcode, "END; (* derpinit *)\n\n"); + /* End of printing derpinit */ + + fprintf(pcode, "PROCEDURE hf_dalfa(bj_,tp_: BOOLEAN;xx_: glnarray; VAR gg_: glnpbynp);\n"); + fprintf(pcode, "BEGIN\n"); + fprintf(pcode, "END; (* hf_dalfa *)\n\n"); + /* End of printing hf_dalfa */ + + /*Printing hopfinit */ + fprintf(pcode, "PROCEDURE hopfinit;\nBEGIN\n"); + fprintf(pcode, "END; (* hopfinit *)\n\n"); + /* End of printing hopfinit */ + + break; + case 2: + /*Printing hf_dalfa */ + + fprintf(pcode, "PROCEDURE sp_dalfa(bj_: BOOLEAN;xx_: glnarray; VAR gg_: glnpbynp);\n"); + fprintf(pcode, "BEGIN\n"); + fprintf(pcode, "END; (* sp_dalfa *)\n\n"); + /* End of printing sp_dalfa */ + + /* Printing derpinit */ + fprintf(pcode, "PROCEDURE derpinit;\nBEGIN\n"); + fprintf(pcode, "END; (* derpinit *)\n\n"); + /* End of printing derpinit */ + + fprintf(pcode, "PROCEDURE hf_dalfa(bj_,tp_: BOOLEAN;xx_: glnarray; VAR gg_: glnpbynp);\n"); + fprintf(pcode, "BEGIN\n"); + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if ((IsSpecInConstraint(name, charge)==0) && + (IsSpecParam(name, charge)!=1)) { + RenameSpec(rename, name, charge); + fprintf(pcode, "%s:=xx_[%d];\n", rename, dyn); + dyn++; + } /* if */ + } /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(pcode, "%s:=xx_[%d];\n", name, i+NoOfSpec()-NumOfConstraint()); + } /* for i */ + + fprintf(pcode, "IF tp_ THEN BEGIN\n"); + for(i=1; i<=NumbOfParams; i++) { + GetParamNo(i, name, &charge, &form); + if (form==2) + RenameSpec(rename, name, charge); + else + strcpy(rename, name); + fprintf(pcode, "%s:=xx_[n%d];\n", rename, i); + } /* for i */ + fprintf(pcode, "IF bj_ THEN BEGIN\n"); + GetParamNo(1, name, &charge, &form); + if (form==2) + RenameSpec(rename, name, charge); + else + strcpy(rename, name); + for(j=0; j=1; i--) { + GetParamNo(i, name, &charge, &form); + if (form==2) + RenameSpec(rename, name, charge); + else + strcpy(rename, name); + fprintf(pcode, "%s:=xx_[n%d];\n", rename, NumbOfParams+1-i); + } /* for i */ + fprintf(pcode, "IF bj_ THEN BEGIN\n"); + GetParamNo(2, name, &charge, &form); + if (form==2) + RenameSpec(rename, name, charge); + else + strcpy(rename, name); + for(j=0; j0.0) + fprintf(pcode, "initndir[%d]:=1;\n", dyn); + else + fprintf(pcode, "initndir[%d]:=-1;\n", dyn); + fprintf(pcode, "inithmax[%d]:=%e;\n", dyn, fabs(temp)); + } /* if */ + } /* else */ + + temp=GetSpecConst(name, charge, "Bfxmax"); + BfErrorCode= GetError(); + if (BfErrorCode==NotFound) { + fprintf(pcode, "initxupp[%d]:=%e;\n", dyn, 1.0E3); + } else { + if (BfErrorCode==NoError) { + fprintf(pcode, "initxupp[%d]:=%e;\n", dyn, temp); + } /* if */ + } /* else */ + + temp=GetSpecConst(name, charge, "Bfxmin"); + BfErrorCode= GetError(); + if (BfErrorCode==NotFound) { + fprintf(pcode, "initxlow[%d]:=%e;\n", dyn, 0.0); + } else { + if (BfErrorCode==NoError) { + fprintf(pcode, "initxlow[%d]:=%e;\n", dyn, temp); + } /* if */ + } /* else */ + + temp=GetSpecConst(name, charge, "Bfpref"); + BfErrorCode= GetError(); + if (BfErrorCode==NotFound) { + fprintf(pcode, "initpref[%d]:=%e;\n", dyn, 0.1); + } else { + if (BfErrorCode==NoError) { + fprintf(pcode, "initpref[%d]:=%e;\n", dyn, temp); + } /* if */ + } /* else */ + + } /* if */ + } /* for i */ + for(i=1; i<=NumOfParameter(); i++) { + GetParamNo(i, name, &charge, &form); + if (form==1) { + GetInitParam(name, &temp); + fprintf(pcode, "xx[n%d]:=%e;\n", i, temp); + temp=GetDirectForParam(name); + if (temp>0.0) + fprintf(pcode, "initndir[n%d]:=1;\n", i); + else + fprintf(pcode, "initndir[n%d]:=-1;\n", i); + GetDeltaParam(name, &temp); + fprintf(pcode, "inithmax[n%d]:=%e;\n", i, fabs(temp)); + GetLowHighPrefParam(name, &temp, &temp1, &temp2); + fprintf(pcode, "initxlow[n%d]:=%e;\n", i, temp); + fprintf(pcode, "initxupp[n%d]:=%e;\n", i, temp1); + if ((temp2>1.0) && (temp2<0.0)) + fprintf(pcode, "KnCont: Pref. for %s must between 0 and 1.\n", name); + else + fprintf(pcode, "initpref[n%d]:=%e;\n", i, temp2); + } /* if */ + else { + GetInitConc(name, charge, &temp); + fprintf(pcode, "xx[n%d]:=%e;\n", i, temp); + temp=GetDirectForConc(name, charge); + if (temp>0.0) + fprintf(pcode, "initndir[n%d]:=1;\n", i); + else + fprintf(pcode, "initndir[n%d]:=-1;\n", i); + GetDeltaConc(name, charge, &temp); + fprintf(pcode, "inithmax[n%d]:=%e;\n", i, fabs(temp)); + GetLowHighPrefConc(name, charge, &temp, &temp1, &temp2); + fprintf(pcode, "initxlow[n%d]:=%e;\n", i, temp); + fprintf(pcode, "initxupp[n%d]:=%e;\n", i, temp1); + if ((temp2>1.0) && (temp2<0.0)) + fprintf(pcode, "KnCont: Pref. for %s(%d) must between 0 and 1.\n", + name, (int)charge); + else + fprintf(pcode, "initpref[n%d]:=%e;\n", i, temp2); + } /* else */ + } /* for i */ + fprintf(pcode, "END; (* hopfinit *)\n\n"); + + /* End of printing hopfinit */ + + break; + } /* switch NumbOfParams */ + + /* Printing detnumparam */ + + fprintf(pcode, "PROCEDURE detnumparam;\n"); + fprintf(pcode, "BEGIN\n"); + fprintf(pcode, " numparam:=%d;\n", NumbOfParams); + fprintf(pcode, "END; (* detnumparam *)\n\n"); + /* End of printing detnumparam */ + + + StringFree(name); + StringFree(rename); +} /* KnCont */ + diff --git a/src/kncont.h b/src/kncont.h new file mode 100644 index 0000000..f0d1cc3 --- /dev/null +++ b/src/kncont.h @@ -0,0 +1,9 @@ +/* Code generator KnCont + CopyWrong by Kenneth Geisshirt, 1993. + + See kc.tex for details. + + Last updated: 11 May 1995 by KN +*/ + +extern void KnCont(FILE *, FILE *); diff --git a/src/lex.c b/src/lex.c new file mode 100644 index 0000000..845bef1 --- /dev/null +++ b/src/lex.c @@ -0,0 +1,2089 @@ + +#line 3 "lex.yy.c" + +#define YY_INT_ALIGNED short int + +/* A lexical scanner generated by flex */ + +#define FLEX_SCANNER +#define YY_FLEX_MAJOR_VERSION 2 +#define YY_FLEX_MINOR_VERSION 5 +#define YY_FLEX_SUBMINOR_VERSION 35 +#if YY_FLEX_SUBMINOR_VERSION > 0 +#define FLEX_BETA +#endif + +/* First, we deal with platform-specific or compiler-specific issues. */ + +/* begin standard C headers. */ +#include +#include +#include +#include + +/* end standard C headers. */ + +/* flex integer type definitions */ + +#ifndef FLEXINT_H +#define FLEXINT_H + +/* C99 systems have . Non-C99 systems may or may not. */ + +#if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L + +/* C99 says to define __STDC_LIMIT_MACROS before including stdint.h, + * if you want the limit (max/min) macros for int types. + */ +#ifndef __STDC_LIMIT_MACROS +#define __STDC_LIMIT_MACROS 1 +#endif + +#include +typedef int8_t flex_int8_t; +typedef uint8_t flex_uint8_t; +typedef int16_t flex_int16_t; +typedef uint16_t flex_uint16_t; +typedef int32_t flex_int32_t; +typedef uint32_t flex_uint32_t; +typedef uint64_t flex_uint64_t; +#else +typedef signed char flex_int8_t; +typedef short int flex_int16_t; +typedef int flex_int32_t; +typedef unsigned char flex_uint8_t; +typedef unsigned short int flex_uint16_t; +typedef unsigned int flex_uint32_t; +#endif /* ! C99 */ + +/* Limits of integral types. */ +#ifndef INT8_MIN +#define INT8_MIN (-128) +#endif +#ifndef INT16_MIN +#define INT16_MIN (-32767-1) +#endif +#ifndef INT32_MIN +#define INT32_MIN (-2147483647-1) +#endif +#ifndef INT8_MAX +#define INT8_MAX (127) +#endif +#ifndef INT16_MAX +#define INT16_MAX (32767) +#endif +#ifndef INT32_MAX +#define INT32_MAX (2147483647) +#endif +#ifndef UINT8_MAX +#define UINT8_MAX (255U) +#endif +#ifndef UINT16_MAX +#define UINT16_MAX (65535U) +#endif +#ifndef UINT32_MAX +#define UINT32_MAX (4294967295U) +#endif + +#endif /* ! FLEXINT_H */ + +#ifdef __cplusplus + +/* The "const" storage-class-modifier is valid. */ +#define YY_USE_CONST + +#else /* ! __cplusplus */ + +/* C99 requires __STDC__ to be defined as 1. */ +#if defined (__STDC__) + +#define YY_USE_CONST + +#endif /* defined (__STDC__) */ +#endif /* ! __cplusplus */ + +#ifdef YY_USE_CONST +#define yyconst const +#else +#define yyconst +#endif + +/* Returned upon end-of-file. */ +#define YY_NULL 0 + +/* Promotes a possibly negative, possibly signed char to an unsigned + * integer for use as an array index. If the signed char is negative, + * we want to instead treat it as an 8-bit unsigned char, hence the + * double cast. + */ +#define YY_SC_TO_UI(c) ((unsigned int) (unsigned char) c) + +/* Enter a start condition. This macro really ought to take a parameter, + * but we do it the disgusting crufty way forced on us by the ()-less + * definition of BEGIN. + */ +#define BEGIN (yy_start) = 1 + 2 * + +/* Translate the current start state into a value that can be later handed + * to BEGIN to return to the state. The YYSTATE alias is for lex + * compatibility. + */ +#define YY_START (((yy_start) - 1) / 2) +#define YYSTATE YY_START + +/* Action number for EOF rule of a given start state. */ +#define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1) + +/* Special action meaning "start processing a new file". */ +#define YY_NEW_FILE yyrestart(yyin ) + +#define YY_END_OF_BUFFER_CHAR 0 + +/* Size of default input buffer. */ +#ifndef YY_BUF_SIZE +#define YY_BUF_SIZE 16384 +#endif + +/* The state buf must be large enough to hold one state per character in the main buffer. + */ +#define YY_STATE_BUF_SIZE ((YY_BUF_SIZE + 2) * sizeof(yy_state_type)) + +#ifndef YY_TYPEDEF_YY_BUFFER_STATE +#define YY_TYPEDEF_YY_BUFFER_STATE +typedef struct yy_buffer_state *YY_BUFFER_STATE; +#endif + +#ifndef YY_TYPEDEF_YY_SIZE_T +#define YY_TYPEDEF_YY_SIZE_T +typedef size_t yy_size_t; +#endif + +extern yy_size_t yyleng; + +extern FILE *yyin, *yyout; + +#define EOB_ACT_CONTINUE_SCAN 0 +#define EOB_ACT_END_OF_FILE 1 +#define EOB_ACT_LAST_MATCH 2 + + #define YY_LESS_LINENO(n) + +/* Return all but the first "n" matched characters back to the input stream. */ +#define yyless(n) \ + do \ + { \ + /* Undo effects of setting up yytext. */ \ + int yyless_macro_arg = (n); \ + YY_LESS_LINENO(yyless_macro_arg);\ + *yy_cp = (yy_hold_char); \ + YY_RESTORE_YY_MORE_OFFSET \ + (yy_c_buf_p) = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \ + YY_DO_BEFORE_ACTION; /* set up yytext again */ \ + } \ + while ( 0 ) + +#define unput(c) yyunput( c, (yytext_ptr) ) + +#ifndef YY_STRUCT_YY_BUFFER_STATE +#define YY_STRUCT_YY_BUFFER_STATE +struct yy_buffer_state + { + FILE *yy_input_file; + + char *yy_ch_buf; /* input buffer */ + char *yy_buf_pos; /* current position in input buffer */ + + /* Size of input buffer in bytes, not including room for EOB + * characters. + */ + yy_size_t yy_buf_size; + + /* Number of characters read into yy_ch_buf, not including EOB + * characters. + */ + yy_size_t yy_n_chars; + + /* Whether we "own" the buffer - i.e., we know we created it, + * and can realloc() it to grow it, and should free() it to + * delete it. + */ + int yy_is_our_buffer; + + /* Whether this is an "interactive" input source; if so, and + * if we're using stdio for input, then we want to use getc() + * instead of fread(), to make sure we stop fetching input after + * each newline. + */ + int yy_is_interactive; + + /* Whether we're considered to be at the beginning of a line. + * If so, '^' rules will be active on the next match, otherwise + * not. + */ + int yy_at_bol; + + int yy_bs_lineno; /**< The line count. */ + int yy_bs_column; /**< The column count. */ + + /* Whether to try to fill the input buffer when we reach the + * end of it. + */ + int yy_fill_buffer; + + int yy_buffer_status; + +#define YY_BUFFER_NEW 0 +#define YY_BUFFER_NORMAL 1 + /* When an EOF's been seen but there's still some text to process + * then we mark the buffer as YY_EOF_PENDING, to indicate that we + * shouldn't try reading from the input source any more. We might + * still have a bunch of tokens to match, though, because of + * possible backing-up. + * + * When we actually see the EOF, we change the status to "new" + * (via yyrestart()), so that the user can continue scanning by + * just pointing yyin at a new input file. + */ +#define YY_BUFFER_EOF_PENDING 2 + + }; +#endif /* !YY_STRUCT_YY_BUFFER_STATE */ + +/* Stack of input buffers. */ +static size_t yy_buffer_stack_top = 0; /**< index of top of stack. */ +static size_t yy_buffer_stack_max = 0; /**< capacity of stack. */ +static YY_BUFFER_STATE * yy_buffer_stack = 0; /**< Stack as an array. */ + +/* We provide macros for accessing buffer states in case in the + * future we want to put the buffer states in a more general + * "scanner state". + * + * Returns the top of the stack, or NULL. + */ +#define YY_CURRENT_BUFFER ( (yy_buffer_stack) \ + ? (yy_buffer_stack)[(yy_buffer_stack_top)] \ + : NULL) + +/* Same as previous macro, but useful when we know that the buffer stack is not + * NULL or when we need an lvalue. For internal use only. + */ +#define YY_CURRENT_BUFFER_LVALUE (yy_buffer_stack)[(yy_buffer_stack_top)] + +/* yy_hold_char holds the character lost when yytext is formed. */ +static char yy_hold_char; +static yy_size_t yy_n_chars; /* number of characters read into yy_ch_buf */ +yy_size_t yyleng; + +/* Points to current character in buffer. */ +static char *yy_c_buf_p = (char *) 0; +static int yy_init = 0; /* whether we need to initialize */ +static int yy_start = 0; /* start state number */ + +/* Flag which is used to allow yywrap()'s to do buffer switches + * instead of setting up a fresh yyin. A bit of a hack ... + */ +static int yy_did_buffer_switch_on_eof; + +void yyrestart (FILE *input_file ); +void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer ); +YY_BUFFER_STATE yy_create_buffer (FILE *file,int size ); +void yy_delete_buffer (YY_BUFFER_STATE b ); +void yy_flush_buffer (YY_BUFFER_STATE b ); +void yypush_buffer_state (YY_BUFFER_STATE new_buffer ); +void yypop_buffer_state (void ); + +static void yyensure_buffer_stack (void ); +static void yy_load_buffer_state (void ); +static void yy_init_buffer (YY_BUFFER_STATE b,FILE *file ); + +#define YY_FLUSH_BUFFER yy_flush_buffer(YY_CURRENT_BUFFER ) + +YY_BUFFER_STATE yy_scan_buffer (char *base,yy_size_t size ); +YY_BUFFER_STATE yy_scan_string (yyconst char *yy_str ); +YY_BUFFER_STATE yy_scan_bytes (yyconst char *bytes,yy_size_t len ); + +void *yyalloc (yy_size_t ); +void *yyrealloc (void *,yy_size_t ); +void yyfree (void * ); + +#define yy_new_buffer yy_create_buffer + +#define yy_set_interactive(is_interactive) \ + { \ + if ( ! YY_CURRENT_BUFFER ){ \ + yyensure_buffer_stack (); \ + YY_CURRENT_BUFFER_LVALUE = \ + yy_create_buffer(yyin,YY_BUF_SIZE ); \ + } \ + YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \ + } + +#define yy_set_bol(at_bol) \ + { \ + if ( ! YY_CURRENT_BUFFER ){\ + yyensure_buffer_stack (); \ + YY_CURRENT_BUFFER_LVALUE = \ + yy_create_buffer(yyin,YY_BUF_SIZE ); \ + } \ + YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \ + } + +#define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol) + +/* Begin user sect3 */ + +typedef unsigned char YY_CHAR; + +FILE *yyin = (FILE *) 0, *yyout = (FILE *) 0; + +typedef int yy_state_type; + +extern int yylineno; + +int yylineno = 1; + +extern char *yytext; +#define yytext_ptr yytext + +static yy_state_type yy_get_previous_state (void ); +static yy_state_type yy_try_NUL_trans (yy_state_type current_state ); +static int yy_get_next_buffer (void ); +static void yy_fatal_error (yyconst char msg[] ); + +/* Done after the current pattern has been matched and before the + * corresponding action - sets up yytext. + */ +#define YY_DO_BEFORE_ACTION \ + (yytext_ptr) = yy_bp; \ + yyleng = (yy_size_t) (yy_cp - yy_bp); \ + (yy_hold_char) = *yy_cp; \ + *yy_cp = '\0'; \ + (yy_c_buf_p) = yy_cp; + +#define YY_NUM_RULES 50 +#define YY_END_OF_BUFFER 51 +/* This struct is not used in this scanner, + but its presence is necessary. */ +struct yy_trans_info + { + flex_int32_t yy_verify; + flex_int32_t yy_nxt; + }; +static yyconst flex_int16_t yy_accept[97] = + { 0, + 0, 0, 51, 50, 1, 2, 49, 50, 24, 25, + 26, 42, 38, 46, 39, 32, 43, 20, 48, 47, + 50, 31, 21, 21, 44, 45, 41, 21, 21, 21, + 21, 21, 21, 21, 21, 0, 4, 0, 40, 28, + 20, 3, 0, 20, 0, 0, 21, 21, 21, 21, + 21, 21, 34, 33, 7, 21, 21, 21, 36, 35, + 0, 0, 27, 0, 29, 30, 21, 21, 21, 9, + 5, 6, 8, 10, 0, 0, 0, 20, 15, 14, + 16, 12, 11, 13, 0, 0, 18, 17, 19, 0, + 23, 0, 0, 0, 22, 0 + + } ; + +static yyconst flex_int32_t yy_ec[256] = + { 0, + 1, 1, 1, 1, 1, 1, 1, 1, 2, 3, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 2, 1, 4, 5, 1, 1, 1, 6, 7, + 8, 9, 10, 11, 12, 13, 14, 15, 16, 16, + 16, 16, 16, 16, 16, 16, 16, 17, 18, 19, + 20, 21, 1, 1, 22, 22, 22, 22, 23, 22, + 22, 22, 22, 22, 24, 23, 22, 22, 22, 22, + 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, + 25, 1, 26, 27, 1, 1, 28, 22, 29, 22, + + 30, 22, 31, 32, 33, 22, 34, 35, 36, 37, + 38, 39, 22, 40, 41, 42, 22, 43, 22, 44, + 22, 22, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1 + } ; + +static yyconst flex_int32_t yy_meta[45] = + { 0, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 2, 2, 1, 1, 1, 1, + 1, 2, 2, 2, 1, 1, 1, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2 + } ; + +static yyconst flex_int16_t yy_base[98] = + { 0, + 0, 0, 122, 123, 123, 123, 123, 82, 123, 36, + 123, 111, 123, 123, 98, 31, 109, 37, 123, 123, + 36, 123, 0, 0, 123, 123, 123, 20, 79, 72, + 36, 21, 82, 86, 44, 26, 123, 105, 123, 123, + 52, 123, 54, 58, 91, 90, 0, 72, 76, 80, + 66, 67, 123, 123, 0, 74, 67, 66, 123, 123, + 62, 68, 123, 68, 123, 123, 59, 62, 61, 65, + 0, 0, 64, 63, 66, 56, 61, 70, 60, 59, + 58, 0, 0, 0, 53, 46, 0, 0, 0, 51, + 123, 37, 42, 24, 123, 123, 58 + + } ; + +static yyconst flex_int16_t yy_def[98] = + { 0, + 96, 1, 96, 96, 96, 96, 96, 96, 96, 96, + 96, 96, 96, 96, 96, 96, 96, 96, 96, 96, + 96, 96, 97, 97, 96, 96, 96, 97, 97, 97, + 97, 97, 97, 97, 97, 96, 96, 96, 96, 96, + 96, 96, 96, 96, 96, 96, 97, 97, 97, 97, + 97, 97, 96, 96, 97, 97, 97, 97, 96, 96, + 96, 96, 96, 96, 96, 96, 97, 97, 97, 97, + 97, 97, 97, 97, 96, 96, 96, 96, 97, 97, + 97, 97, 97, 97, 96, 96, 97, 97, 97, 96, + 96, 96, 96, 96, 96, 0, 96 + + } ; + +static yyconst flex_int16_t yy_nxt[168] = + { 0, + 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, + 14, 15, 16, 17, 18, 18, 19, 20, 21, 22, + 4, 23, 23, 24, 25, 26, 27, 28, 29, 30, + 23, 23, 23, 31, 32, 23, 23, 23, 23, 23, + 33, 34, 35, 23, 37, 41, 41, 45, 48, 43, + 38, 44, 44, 61, 53, 46, 54, 55, 56, 47, + 49, 50, 59, 95, 60, 62, 41, 41, 41, 41, + 43, 94, 44, 44, 64, 78, 78, 77, 93, 77, + 92, 64, 78, 78, 78, 78, 64, 91, 90, 89, + 88, 87, 86, 85, 84, 83, 82, 81, 80, 79, + + 76, 75, 74, 73, 72, 71, 70, 69, 68, 67, + 66, 65, 63, 58, 57, 52, 51, 42, 40, 39, + 36, 96, 3, 96, 96, 96, 96, 96, 96, 96, + 96, 96, 96, 96, 96, 96, 96, 96, 96, 96, + 96, 96, 96, 96, 96, 96, 96, 96, 96, 96, + 96, 96, 96, 96, 96, 96, 96, 96, 96, 96, + 96, 96, 96, 96, 96, 96, 96 + } ; + +static yyconst flex_int16_t yy_chk[168] = + { 0, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 10, 16, 16, 21, 28, 18, + 10, 18, 18, 36, 31, 21, 31, 32, 32, 97, + 28, 28, 35, 94, 35, 36, 41, 41, 43, 43, + 44, 93, 44, 44, 41, 77, 77, 64, 92, 64, + 90, 41, 64, 64, 78, 78, 41, 86, 85, 81, + 80, 79, 76, 75, 74, 73, 70, 69, 68, 67, + + 62, 61, 58, 57, 56, 52, 51, 50, 49, 48, + 46, 45, 38, 34, 33, 30, 29, 17, 15, 12, + 8, 3, 96, 96, 96, 96, 96, 96, 96, 96, + 96, 96, 96, 96, 96, 96, 96, 96, 96, 96, + 96, 96, 96, 96, 96, 96, 96, 96, 96, 96, + 96, 96, 96, 96, 96, 96, 96, 96, 96, 96, + 96, 96, 96, 96, 96, 96, 96 + } ; + +static yy_state_type yy_last_accepting_state; +static char *yy_last_accepting_cpos; + +extern int yy_flex_debug; +int yy_flex_debug = 0; + +/* The intent behind this definition is that it'll catch + * any uses of REJECT which flex missed. + */ +#define REJECT reject_used_but_not_detected +#define yymore() yymore_used_but_not_detected +#define YY_MORE_ADJ 0 +#define YY_RESTORE_YY_MORE_OFFSET +char *yytext; +#line 1 "kc.l" +#line 518 "lex.yy.c" + +#define INITIAL 0 + +#ifndef YY_NO_UNISTD_H +/* Special case for "unistd.h", since it is non-ANSI. We include it way + * down here because we want the user's section 1 to have been scanned first. + * The user has a chance to override it with an option. + */ +#include +#endif + +#ifndef YY_EXTRA_TYPE +#define YY_EXTRA_TYPE void * +#endif + +static int yy_init_globals (void ); + +/* Accessor methods to globals. + These are made visible to non-reentrant scanners for convenience. */ + +int yylex_destroy (void ); + +int yyget_debug (void ); + +void yyset_debug (int debug_flag ); + +YY_EXTRA_TYPE yyget_extra (void ); + +void yyset_extra (YY_EXTRA_TYPE user_defined ); + +FILE *yyget_in (void ); + +void yyset_in (FILE * in_str ); + +FILE *yyget_out (void ); + +void yyset_out (FILE * out_str ); + +yy_size_t yyget_leng (void ); + +char *yyget_text (void ); + +int yyget_lineno (void ); + +void yyset_lineno (int line_number ); + +/* Macros after this point can all be overridden by user definitions in + * section 1. + */ + +#ifndef YY_SKIP_YYWRAP +#ifdef __cplusplus +extern "C" int yywrap (void ); +#else +extern int yywrap (void ); +#endif +#endif + + static void yyunput (int c,char *buf_ptr ); + +#ifndef yytext_ptr +static void yy_flex_strncpy (char *,yyconst char *,int ); +#endif + +#ifdef YY_NEED_STRLEN +static int yy_flex_strlen (yyconst char * ); +#endif + +#ifndef YY_NO_INPUT + +#ifdef __cplusplus +static int yyinput (void ); +#else +static int input (void ); +#endif + +#endif + +/* Amount of stuff to slurp up with each read. */ +#ifndef YY_READ_BUF_SIZE +#define YY_READ_BUF_SIZE 8192 +#endif + +/* Copy whatever the last rule matched to the standard output. */ +#ifndef ECHO +/* This used to be an fputs(), but since the string might contain NUL's, + * we now use fwrite(). + */ +#define ECHO fwrite( yytext, yyleng, 1, yyout ) +#endif + +/* Gets input and stuffs it into "buf". number of characters read, or YY_NULL, + * is returned in "result". + */ +#ifndef YY_INPUT +#define YY_INPUT(buf,result,max_size) \ + if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \ + { \ + int c = '*'; \ + yy_size_t n; \ + for ( n = 0; n < max_size && \ + (c = getc( yyin )) != EOF && c != '\n'; ++n ) \ + buf[n] = (char) c; \ + if ( c == '\n' ) \ + buf[n++] = (char) c; \ + if ( c == EOF && ferror( yyin ) ) \ + YY_FATAL_ERROR( "input in flex scanner failed" ); \ + result = n; \ + } \ + else \ + { \ + errno=0; \ + while ( (result = fread(buf, 1, max_size, yyin))==0 && ferror(yyin)) \ + { \ + if( errno != EINTR) \ + { \ + YY_FATAL_ERROR( "input in flex scanner failed" ); \ + break; \ + } \ + errno=0; \ + clearerr(yyin); \ + } \ + }\ +\ + +#endif + +/* No semi-colon after return; correct usage is to write "yyterminate();" - + * we don't want an extra ';' after the "return" because that will cause + * some compilers to complain about unreachable statements. + */ +#ifndef yyterminate +#define yyterminate() return YY_NULL +#endif + +/* Number of entries by which start-condition stack grows. */ +#ifndef YY_START_STACK_INCR +#define YY_START_STACK_INCR 25 +#endif + +/* Report a fatal error. */ +#ifndef YY_FATAL_ERROR +#define YY_FATAL_ERROR(msg) yy_fatal_error( msg ) +#endif + +/* end tables serialization structures and prototypes */ + +/* Default declaration of generated scanner - a define so the user can + * easily add parameters. + */ +#ifndef YY_DECL +#define YY_DECL_IS_OURS 1 + +extern int yylex (void); + +#define YY_DECL int yylex (void) +#endif /* !YY_DECL */ + +/* Code executed at the beginning of each rule, after yytext and yyleng + * have been set up. + */ +#ifndef YY_USER_ACTION +#define YY_USER_ACTION +#endif + +/* Code executed at the end of each rule. */ +#ifndef YY_BREAK +#define YY_BREAK break; +#endif + +#define YY_RULE_SETUP \ + YY_USER_ACTION + +/** The main scanner function which does all the work. + */ +YY_DECL +{ + register yy_state_type yy_current_state; + register char *yy_cp, *yy_bp; + register int yy_act; + +#line 5 "kc.l" + +#line 702 "lex.yy.c" + + if ( !(yy_init) ) + { + (yy_init) = 1; + +#ifdef YY_USER_INIT + YY_USER_INIT; +#endif + + if ( ! (yy_start) ) + (yy_start) = 1; /* first start state */ + + if ( ! yyin ) + yyin = stdin; + + if ( ! yyout ) + yyout = stdout; + + if ( ! YY_CURRENT_BUFFER ) { + yyensure_buffer_stack (); + YY_CURRENT_BUFFER_LVALUE = + yy_create_buffer(yyin,YY_BUF_SIZE ); + } + + yy_load_buffer_state( ); + } + + while ( 1 ) /* loops until end-of-file is reached */ + { + yy_cp = (yy_c_buf_p); + + /* Support of yytext. */ + *yy_cp = (yy_hold_char); + + /* yy_bp points to the position in yy_ch_buf of the start of + * the current run. + */ + yy_bp = yy_cp; + + yy_current_state = (yy_start); +yy_match: + do + { + register YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)]; + if ( yy_accept[yy_current_state] ) + { + (yy_last_accepting_state) = yy_current_state; + (yy_last_accepting_cpos) = yy_cp; + } + while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) + { + yy_current_state = (int) yy_def[yy_current_state]; + if ( yy_current_state >= 97 ) + yy_c = yy_meta[(unsigned int) yy_c]; + } + yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c]; + ++yy_cp; + } + while ( yy_base[yy_current_state] != 123 ); + +yy_find_action: + yy_act = yy_accept[yy_current_state]; + if ( yy_act == 0 ) + { /* have to back up */ + yy_cp = (yy_last_accepting_cpos); + yy_current_state = (yy_last_accepting_state); + yy_act = yy_accept[yy_current_state]; + } + + YY_DO_BEFORE_ACTION; + +do_action: /* This label is used only to access EOF actions. */ + + switch ( yy_act ) + { /* beginning of action switch */ + case 0: /* must back up */ + /* undo the effects of YY_DO_BEFORE_ACTION */ + *yy_cp = (yy_hold_char); + yy_cp = (yy_last_accepting_cpos); + yy_current_state = (yy_last_accepting_state); + goto yy_find_action; + +case 1: +YY_RULE_SETUP +#line 6 "kc.l" +; + YY_BREAK +case 2: +/* rule 2 can match eol */ +YY_RULE_SETUP +#line 7 "kc.l" +lineno++; + YY_BREAK +case 3: +YY_RULE_SETUP +#line 8 "kc.l" +{ CommentC(); } + YY_BREAK +case 4: +YY_RULE_SETUP +#line 9 "kc.l" +{ CommentPas(); } + YY_BREAK +case 5: +YY_RULE_SETUP +#line 11 "kc.l" +return fun_exp; + YY_BREAK +case 6: +YY_RULE_SETUP +#line 12 "kc.l" +return fun_log; + YY_BREAK +case 7: +YY_RULE_SETUP +#line 13 "kc.l" +return fun_ln; + YY_BREAK +case 8: +YY_RULE_SETUP +#line 14 "kc.l" +return fun_sin; + YY_BREAK +case 9: +YY_RULE_SETUP +#line 15 "kc.l" +return fun_cos; + YY_BREAK +case 10: +YY_RULE_SETUP +#line 16 "kc.l" +return fun_tan; + YY_BREAK +case 11: +YY_RULE_SETUP +#line 17 "kc.l" +return fun_sinh; + YY_BREAK +case 12: +YY_RULE_SETUP +#line 18 "kc.l" +return fun_cosh; + YY_BREAK +case 13: +YY_RULE_SETUP +#line 19 "kc.l" +return fun_tanh; + YY_BREAK +case 14: +YY_RULE_SETUP +#line 20 "kc.l" +return fun_asin; + YY_BREAK +case 15: +YY_RULE_SETUP +#line 21 "kc.l" +return fun_acos; + YY_BREAK +case 16: +YY_RULE_SETUP +#line 22 "kc.l" +return fun_atan; + YY_BREAK +case 17: +YY_RULE_SETUP +#line 23 "kc.l" +return fun_asinh; + YY_BREAK +case 18: +YY_RULE_SETUP +#line 24 "kc.l" +return fun_acosh; + YY_BREAK +case 19: +YY_RULE_SETUP +#line 25 "kc.l" +return fun_atanh; + YY_BREAK +case 20: +YY_RULE_SETUP +#line 27 "kc.l" +{ num(); yylval.dval=value; return numbers; } + YY_BREAK +case 21: +YY_RULE_SETUP +#line 28 "kc.l" +{ (void) strcpy(yylval.name, yytext); return names; } + YY_BREAK +case 22: +YY_RULE_SETUP +#line 29 "kc.l" +return param; + YY_BREAK +case 23: +YY_RULE_SETUP +#line 30 "kc.l" +return print; + YY_BREAK +case 24: +YY_RULE_SETUP +#line 31 "kc.l" +return prime; + YY_BREAK +case 25: +YY_RULE_SETUP +#line 32 "kc.l" +return leftpar; + YY_BREAK +case 26: +YY_RULE_SETUP +#line 33 "kc.l" +return rightpar; + YY_BREAK +case 27: +YY_RULE_SETUP +#line 34 "kc.l" +return time0; + YY_BREAK +case 28: +YY_RULE_SETUP +#line 35 "kc.l" +return oneway; + YY_BREAK +case 29: +YY_RULE_SETUP +#line 36 "kc.l" +return twoways; + YY_BREAK +case 30: +YY_RULE_SETUP +#line 37 "kc.l" +return twoways; + YY_BREAK +case 31: +YY_RULE_SETUP +#line 38 "kc.l" +return equal; + YY_BREAK +case 32: +YY_RULE_SETUP +#line 39 "kc.l" +return radical; + YY_BREAK +case 33: +YY_RULE_SETUP +#line 40 "kc.l" +{ strcpy(yylval.name, "k"); return leftarr; } + YY_BREAK +case 34: +YY_RULE_SETUP +#line 41 "kc.l" +{ strcpy(yylval.name, "k"); return rightarr; } + YY_BREAK +case 35: +YY_RULE_SETUP +#line 42 "kc.l" +{ strcpy(yylval.name, "v"); return leftarr; } + YY_BREAK +case 36: +YY_RULE_SETUP +#line 43 "kc.l" +{ strcpy(yylval.name, "v"); return rightarr; } + YY_BREAK +case 37: +YY_RULE_SETUP +#line 44 "kc.l" +return K; + YY_BREAK +case 38: +YY_RULE_SETUP +#line 45 "kc.l" +return plus; + YY_BREAK +case 39: +YY_RULE_SETUP +#line 46 "kc.l" +return minus; + YY_BREAK +case 40: +YY_RULE_SETUP +#line 47 "kc.l" +return powop; + YY_BREAK +case 41: +YY_RULE_SETUP +#line 48 "kc.l" +return powop; + YY_BREAK +case 42: +YY_RULE_SETUP +#line 49 "kc.l" +return multi; + YY_BREAK +case 43: +YY_RULE_SETUP +#line 50 "kc.l" +return pdiv; + YY_BREAK +case 44: +YY_RULE_SETUP +#line 51 "kc.l" +return leftconc; + YY_BREAK +case 45: +YY_RULE_SETUP +#line 52 "kc.l" +return rightconc; + YY_BREAK +case 46: +YY_RULE_SETUP +#line 53 "kc.l" +return comma; + YY_BREAK +case 47: +YY_RULE_SETUP +#line 54 "kc.l" +return semicolon; + YY_BREAK +case 48: +YY_RULE_SETUP +#line 55 "kc.l" +return colon; + YY_BREAK +case 49: +YY_RULE_SETUP +#line 56 "kc.l" +return quotation; + YY_BREAK +case 50: +YY_RULE_SETUP +#line 58 "kc.l" +ECHO; + YY_BREAK +#line 1036 "lex.yy.c" +case YY_STATE_EOF(INITIAL): + yyterminate(); + + case YY_END_OF_BUFFER: + { + /* Amount of text matched not including the EOB char. */ + int yy_amount_of_matched_text = (int) (yy_cp - (yytext_ptr)) - 1; + + /* Undo the effects of YY_DO_BEFORE_ACTION. */ + *yy_cp = (yy_hold_char); + YY_RESTORE_YY_MORE_OFFSET + + if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW ) + { + /* We're scanning a new file or input source. It's + * possible that this happened because the user + * just pointed yyin at a new source and called + * yylex(). If so, then we have to assure + * consistency between YY_CURRENT_BUFFER and our + * globals. Here is the right place to do so, because + * this is the first action (other than possibly a + * back-up) that will match for the new input source. + */ + (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; + YY_CURRENT_BUFFER_LVALUE->yy_input_file = yyin; + YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL; + } + + /* Note that here we test for yy_c_buf_p "<=" to the position + * of the first EOB in the buffer, since yy_c_buf_p will + * already have been incremented past the NUL character + * (since all states make transitions on EOB to the + * end-of-buffer state). Contrast this with the test + * in input(). + */ + if ( (yy_c_buf_p) <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] ) + { /* This was really a NUL. */ + yy_state_type yy_next_state; + + (yy_c_buf_p) = (yytext_ptr) + yy_amount_of_matched_text; + + yy_current_state = yy_get_previous_state( ); + + /* Okay, we're now positioned to make the NUL + * transition. We couldn't have + * yy_get_previous_state() go ahead and do it + * for us because it doesn't know how to deal + * with the possibility of jamming (and we don't + * want to build jamming into it because then it + * will run more slowly). + */ + + yy_next_state = yy_try_NUL_trans( yy_current_state ); + + yy_bp = (yytext_ptr) + YY_MORE_ADJ; + + if ( yy_next_state ) + { + /* Consume the NUL. */ + yy_cp = ++(yy_c_buf_p); + yy_current_state = yy_next_state; + goto yy_match; + } + + else + { + yy_cp = (yy_c_buf_p); + goto yy_find_action; + } + } + + else switch ( yy_get_next_buffer( ) ) + { + case EOB_ACT_END_OF_FILE: + { + (yy_did_buffer_switch_on_eof) = 0; + + if ( yywrap( ) ) + { + /* Note: because we've taken care in + * yy_get_next_buffer() to have set up + * yytext, we can now set up + * yy_c_buf_p so that if some total + * hoser (like flex itself) wants to + * call the scanner after we return the + * YY_NULL, it'll still work - another + * YY_NULL will get returned. + */ + (yy_c_buf_p) = (yytext_ptr) + YY_MORE_ADJ; + + yy_act = YY_STATE_EOF(YY_START); + goto do_action; + } + + else + { + if ( ! (yy_did_buffer_switch_on_eof) ) + YY_NEW_FILE; + } + break; + } + + case EOB_ACT_CONTINUE_SCAN: + (yy_c_buf_p) = + (yytext_ptr) + yy_amount_of_matched_text; + + yy_current_state = yy_get_previous_state( ); + + yy_cp = (yy_c_buf_p); + yy_bp = (yytext_ptr) + YY_MORE_ADJ; + goto yy_match; + + case EOB_ACT_LAST_MATCH: + (yy_c_buf_p) = + &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)]; + + yy_current_state = yy_get_previous_state( ); + + yy_cp = (yy_c_buf_p); + yy_bp = (yytext_ptr) + YY_MORE_ADJ; + goto yy_find_action; + } + break; + } + + default: + YY_FATAL_ERROR( + "fatal flex scanner internal error--no action found" ); + } /* end of action switch */ + } /* end of scanning one token */ +} /* end of yylex */ + +/* yy_get_next_buffer - try to read in a new buffer + * + * Returns a code representing an action: + * EOB_ACT_LAST_MATCH - + * EOB_ACT_CONTINUE_SCAN - continue scanning from current position + * EOB_ACT_END_OF_FILE - end of file + */ +static int yy_get_next_buffer (void) +{ + register char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf; + register char *source = (yytext_ptr); + register int number_to_move, i; + int ret_val; + + if ( (yy_c_buf_p) > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] ) + YY_FATAL_ERROR( + "fatal flex scanner internal error--end of buffer missed" ); + + if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 ) + { /* Don't try to fill the buffer, so this is an EOF. */ + if ( (yy_c_buf_p) - (yytext_ptr) - YY_MORE_ADJ == 1 ) + { + /* We matched a single character, the EOB, so + * treat this as a final EOF. + */ + return EOB_ACT_END_OF_FILE; + } + + else + { + /* We matched some text prior to the EOB, first + * process it. + */ + return EOB_ACT_LAST_MATCH; + } + } + + /* Try to read more data. */ + + /* First move last chars to start of buffer. */ + number_to_move = (int) ((yy_c_buf_p) - (yytext_ptr)) - 1; + + for ( i = 0; i < number_to_move; ++i ) + *(dest++) = *(source++); + + if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING ) + /* don't do the read, it's not guaranteed to return an EOF, + * just force an EOF + */ + YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars) = 0; + + else + { + yy_size_t num_to_read = + YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1; + + while ( num_to_read <= 0 ) + { /* Not enough room in the buffer - grow it. */ + + /* just a shorter name for the current buffer */ + YY_BUFFER_STATE b = YY_CURRENT_BUFFER; + + int yy_c_buf_p_offset = + (int) ((yy_c_buf_p) - b->yy_ch_buf); + + if ( b->yy_is_our_buffer ) + { + yy_size_t new_size = b->yy_buf_size * 2; + + if ( new_size <= 0 ) + b->yy_buf_size += b->yy_buf_size / 8; + else + b->yy_buf_size *= 2; + + b->yy_ch_buf = (char *) + /* Include room in for 2 EOB chars. */ + yyrealloc((void *) b->yy_ch_buf,b->yy_buf_size + 2 ); + } + else + /* Can't grow it, we don't own it. */ + b->yy_ch_buf = 0; + + if ( ! b->yy_ch_buf ) + YY_FATAL_ERROR( + "fatal error - scanner input buffer overflow" ); + + (yy_c_buf_p) = &b->yy_ch_buf[yy_c_buf_p_offset]; + + num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size - + number_to_move - 1; + + } + + if ( num_to_read > YY_READ_BUF_SIZE ) + num_to_read = YY_READ_BUF_SIZE; + + /* Read in more data. */ + YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]), + (yy_n_chars), num_to_read ); + + YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars); + } + + if ( (yy_n_chars) == 0 ) + { + if ( number_to_move == YY_MORE_ADJ ) + { + ret_val = EOB_ACT_END_OF_FILE; + yyrestart(yyin ); + } + + else + { + ret_val = EOB_ACT_LAST_MATCH; + YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = + YY_BUFFER_EOF_PENDING; + } + } + + else + ret_val = EOB_ACT_CONTINUE_SCAN; + + if ((yy_size_t) ((yy_n_chars) + number_to_move) > YY_CURRENT_BUFFER_LVALUE->yy_buf_size) { + /* Extend the array by 50%, plus the number we really need. */ + yy_size_t new_size = (yy_n_chars) + number_to_move + ((yy_n_chars) >> 1); + YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) yyrealloc((void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf,new_size ); + if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf ) + YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" ); + } + + (yy_n_chars) += number_to_move; + YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] = YY_END_OF_BUFFER_CHAR; + YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] = YY_END_OF_BUFFER_CHAR; + + (yytext_ptr) = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0]; + + return ret_val; +} + +/* yy_get_previous_state - get the state just before the EOB char was reached */ + + static yy_state_type yy_get_previous_state (void) +{ + register yy_state_type yy_current_state; + register char *yy_cp; + + yy_current_state = (yy_start); + + for ( yy_cp = (yytext_ptr) + YY_MORE_ADJ; yy_cp < (yy_c_buf_p); ++yy_cp ) + { + register YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1); + if ( yy_accept[yy_current_state] ) + { + (yy_last_accepting_state) = yy_current_state; + (yy_last_accepting_cpos) = yy_cp; + } + while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) + { + yy_current_state = (int) yy_def[yy_current_state]; + if ( yy_current_state >= 97 ) + yy_c = yy_meta[(unsigned int) yy_c]; + } + yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c]; + } + + return yy_current_state; +} + +/* yy_try_NUL_trans - try to make a transition on the NUL character + * + * synopsis + * next_state = yy_try_NUL_trans( current_state ); + */ + static yy_state_type yy_try_NUL_trans (yy_state_type yy_current_state ) +{ + register int yy_is_jam; + register char *yy_cp = (yy_c_buf_p); + + register YY_CHAR yy_c = 1; + if ( yy_accept[yy_current_state] ) + { + (yy_last_accepting_state) = yy_current_state; + (yy_last_accepting_cpos) = yy_cp; + } + while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) + { + yy_current_state = (int) yy_def[yy_current_state]; + if ( yy_current_state >= 97 ) + yy_c = yy_meta[(unsigned int) yy_c]; + } + yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c]; + yy_is_jam = (yy_current_state == 96); + + return yy_is_jam ? 0 : yy_current_state; +} + + static void yyunput (int c, register char * yy_bp ) +{ + register char *yy_cp; + + yy_cp = (yy_c_buf_p); + + /* undo effects of setting up yytext */ + *yy_cp = (yy_hold_char); + + if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 ) + { /* need to shift things up to make room */ + /* +2 for EOB chars. */ + register yy_size_t number_to_move = (yy_n_chars) + 2; + register char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[ + YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2]; + register char *source = + &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]; + + while ( source > YY_CURRENT_BUFFER_LVALUE->yy_ch_buf ) + *--dest = *--source; + + yy_cp += (int) (dest - source); + yy_bp += (int) (dest - source); + YY_CURRENT_BUFFER_LVALUE->yy_n_chars = + (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_buf_size; + + if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 ) + YY_FATAL_ERROR( "flex scanner push-back overflow" ); + } + + *--yy_cp = (char) c; + + (yytext_ptr) = yy_bp; + (yy_hold_char) = *yy_cp; + (yy_c_buf_p) = yy_cp; +} + +#ifndef YY_NO_INPUT +#ifdef __cplusplus + static int yyinput (void) +#else + static int input (void) +#endif + +{ + int c; + + *(yy_c_buf_p) = (yy_hold_char); + + if ( *(yy_c_buf_p) == YY_END_OF_BUFFER_CHAR ) + { + /* yy_c_buf_p now points to the character we want to return. + * If this occurs *before* the EOB characters, then it's a + * valid NUL; if not, then we've hit the end of the buffer. + */ + if ( (yy_c_buf_p) < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] ) + /* This was really a NUL. */ + *(yy_c_buf_p) = '\0'; + + else + { /* need more input */ + yy_size_t offset = (yy_c_buf_p) - (yytext_ptr); + ++(yy_c_buf_p); + + switch ( yy_get_next_buffer( ) ) + { + case EOB_ACT_LAST_MATCH: + /* This happens because yy_g_n_b() + * sees that we've accumulated a + * token and flags that we need to + * try matching the token before + * proceeding. But for input(), + * there's no matching to consider. + * So convert the EOB_ACT_LAST_MATCH + * to EOB_ACT_END_OF_FILE. + */ + + /* Reset buffer status. */ + yyrestart(yyin ); + + /*FALLTHROUGH*/ + + case EOB_ACT_END_OF_FILE: + { + if ( yywrap( ) ) + return 0; + + if ( ! (yy_did_buffer_switch_on_eof) ) + YY_NEW_FILE; +#ifdef __cplusplus + return yyinput(); +#else + return input(); +#endif + } + + case EOB_ACT_CONTINUE_SCAN: + (yy_c_buf_p) = (yytext_ptr) + offset; + break; + } + } + } + + c = *(unsigned char *) (yy_c_buf_p); /* cast for 8-bit char's */ + *(yy_c_buf_p) = '\0'; /* preserve yytext */ + (yy_hold_char) = *++(yy_c_buf_p); + + return c; +} +#endif /* ifndef YY_NO_INPUT */ + +/** Immediately switch to a different input stream. + * @param input_file A readable stream. + * + * @note This function does not reset the start condition to @c INITIAL . + */ + void yyrestart (FILE * input_file ) +{ + + if ( ! YY_CURRENT_BUFFER ){ + yyensure_buffer_stack (); + YY_CURRENT_BUFFER_LVALUE = + yy_create_buffer(yyin,YY_BUF_SIZE ); + } + + yy_init_buffer(YY_CURRENT_BUFFER,input_file ); + yy_load_buffer_state( ); +} + +/** Switch to a different input buffer. + * @param new_buffer The new input buffer. + * + */ + void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer ) +{ + + /* TODO. We should be able to replace this entire function body + * with + * yypop_buffer_state(); + * yypush_buffer_state(new_buffer); + */ + yyensure_buffer_stack (); + if ( YY_CURRENT_BUFFER == new_buffer ) + return; + + if ( YY_CURRENT_BUFFER ) + { + /* Flush out information for old buffer. */ + *(yy_c_buf_p) = (yy_hold_char); + YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p); + YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars); + } + + YY_CURRENT_BUFFER_LVALUE = new_buffer; + yy_load_buffer_state( ); + + /* We don't actually know whether we did this switch during + * EOF (yywrap()) processing, but the only time this flag + * is looked at is after yywrap() is called, so it's safe + * to go ahead and always set it. + */ + (yy_did_buffer_switch_on_eof) = 1; +} + +static void yy_load_buffer_state (void) +{ + (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; + (yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos; + yyin = YY_CURRENT_BUFFER_LVALUE->yy_input_file; + (yy_hold_char) = *(yy_c_buf_p); +} + +/** Allocate and initialize an input buffer state. + * @param file A readable stream. + * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE. + * + * @return the allocated buffer state. + */ + YY_BUFFER_STATE yy_create_buffer (FILE * file, int size ) +{ + YY_BUFFER_STATE b; + + b = (YY_BUFFER_STATE) yyalloc(sizeof( struct yy_buffer_state ) ); + if ( ! b ) + YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" ); + + b->yy_buf_size = size; + + /* yy_ch_buf has to be 2 characters longer than the size given because + * we need to put in 2 end-of-buffer characters. + */ + b->yy_ch_buf = (char *) yyalloc(b->yy_buf_size + 2 ); + if ( ! b->yy_ch_buf ) + YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" ); + + b->yy_is_our_buffer = 1; + + yy_init_buffer(b,file ); + + return b; +} + +/** Destroy the buffer. + * @param b a buffer created with yy_create_buffer() + * + */ + void yy_delete_buffer (YY_BUFFER_STATE b ) +{ + + if ( ! b ) + return; + + if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */ + YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0; + + if ( b->yy_is_our_buffer ) + yyfree((void *) b->yy_ch_buf ); + + yyfree((void *) b ); +} + +#ifndef __cplusplus +extern int isatty (int ); +#endif /* __cplusplus */ + +/* Initializes or reinitializes a buffer. + * This function is sometimes called more than once on the same buffer, + * such as during a yyrestart() or at EOF. + */ + static void yy_init_buffer (YY_BUFFER_STATE b, FILE * file ) + +{ + int oerrno = errno; + + yy_flush_buffer(b ); + + b->yy_input_file = file; + b->yy_fill_buffer = 1; + + /* If b is the current buffer, then yy_init_buffer was _probably_ + * called from yyrestart() or through yy_get_next_buffer. + * In that case, we don't want to reset the lineno or column. + */ + if (b != YY_CURRENT_BUFFER){ + b->yy_bs_lineno = 1; + b->yy_bs_column = 0; + } + + b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0; + + errno = oerrno; +} + +/** Discard all buffered characters. On the next scan, YY_INPUT will be called. + * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER. + * + */ + void yy_flush_buffer (YY_BUFFER_STATE b ) +{ + if ( ! b ) + return; + + b->yy_n_chars = 0; + + /* We always need two end-of-buffer characters. The first causes + * a transition to the end-of-buffer state. The second causes + * a jam in that state. + */ + b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR; + b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR; + + b->yy_buf_pos = &b->yy_ch_buf[0]; + + b->yy_at_bol = 1; + b->yy_buffer_status = YY_BUFFER_NEW; + + if ( b == YY_CURRENT_BUFFER ) + yy_load_buffer_state( ); +} + +/** Pushes the new state onto the stack. The new state becomes + * the current state. This function will allocate the stack + * if necessary. + * @param new_buffer The new state. + * + */ +void yypush_buffer_state (YY_BUFFER_STATE new_buffer ) +{ + if (new_buffer == NULL) + return; + + yyensure_buffer_stack(); + + /* This block is copied from yy_switch_to_buffer. */ + if ( YY_CURRENT_BUFFER ) + { + /* Flush out information for old buffer. */ + *(yy_c_buf_p) = (yy_hold_char); + YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p); + YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars); + } + + /* Only push if top exists. Otherwise, replace top. */ + if (YY_CURRENT_BUFFER) + (yy_buffer_stack_top)++; + YY_CURRENT_BUFFER_LVALUE = new_buffer; + + /* copied from yy_switch_to_buffer. */ + yy_load_buffer_state( ); + (yy_did_buffer_switch_on_eof) = 1; +} + +/** Removes and deletes the top of the stack, if present. + * The next element becomes the new top. + * + */ +void yypop_buffer_state (void) +{ + if (!YY_CURRENT_BUFFER) + return; + + yy_delete_buffer(YY_CURRENT_BUFFER ); + YY_CURRENT_BUFFER_LVALUE = NULL; + if ((yy_buffer_stack_top) > 0) + --(yy_buffer_stack_top); + + if (YY_CURRENT_BUFFER) { + yy_load_buffer_state( ); + (yy_did_buffer_switch_on_eof) = 1; + } +} + +/* Allocates the stack if it does not exist. + * Guarantees space for at least one push. + */ +static void yyensure_buffer_stack (void) +{ + yy_size_t num_to_alloc; + + if (!(yy_buffer_stack)) { + + /* First allocation is just for 2 elements, since we don't know if this + * scanner will even need a stack. We use 2 instead of 1 to avoid an + * immediate realloc on the next call. + */ + num_to_alloc = 1; + (yy_buffer_stack) = (struct yy_buffer_state**)yyalloc + (num_to_alloc * sizeof(struct yy_buffer_state*) + ); + if ( ! (yy_buffer_stack) ) + YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" ); + + memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*)); + + (yy_buffer_stack_max) = num_to_alloc; + (yy_buffer_stack_top) = 0; + return; + } + + if ((yy_buffer_stack_top) >= ((yy_buffer_stack_max)) - 1){ + + /* Increase the buffer to prepare for a possible push. */ + int grow_size = 8 /* arbitrary grow size */; + + num_to_alloc = (yy_buffer_stack_max) + grow_size; + (yy_buffer_stack) = (struct yy_buffer_state**)yyrealloc + ((yy_buffer_stack), + num_to_alloc * sizeof(struct yy_buffer_state*) + ); + if ( ! (yy_buffer_stack) ) + YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" ); + + /* zero only the new slots.*/ + memset((yy_buffer_stack) + (yy_buffer_stack_max), 0, grow_size * sizeof(struct yy_buffer_state*)); + (yy_buffer_stack_max) = num_to_alloc; + } +} + +/** Setup the input buffer state to scan directly from a user-specified character buffer. + * @param base the character buffer + * @param size the size in bytes of the character buffer + * + * @return the newly allocated buffer state object. + */ +YY_BUFFER_STATE yy_scan_buffer (char * base, yy_size_t size ) +{ + YY_BUFFER_STATE b; + + if ( size < 2 || + base[size-2] != YY_END_OF_BUFFER_CHAR || + base[size-1] != YY_END_OF_BUFFER_CHAR ) + /* They forgot to leave room for the EOB's. */ + return 0; + + b = (YY_BUFFER_STATE) yyalloc(sizeof( struct yy_buffer_state ) ); + if ( ! b ) + YY_FATAL_ERROR( "out of dynamic memory in yy_scan_buffer()" ); + + b->yy_buf_size = size - 2; /* "- 2" to take care of EOB's */ + b->yy_buf_pos = b->yy_ch_buf = base; + b->yy_is_our_buffer = 0; + b->yy_input_file = 0; + b->yy_n_chars = b->yy_buf_size; + b->yy_is_interactive = 0; + b->yy_at_bol = 1; + b->yy_fill_buffer = 0; + b->yy_buffer_status = YY_BUFFER_NEW; + + yy_switch_to_buffer(b ); + + return b; +} + +/** Setup the input buffer state to scan a string. The next call to yylex() will + * scan from a @e copy of @a str. + * @param yystr a NUL-terminated string to scan + * + * @return the newly allocated buffer state object. + * @note If you want to scan bytes that may contain NUL values, then use + * yy_scan_bytes() instead. + */ +YY_BUFFER_STATE yy_scan_string (yyconst char * yystr ) +{ + + return yy_scan_bytes(yystr,strlen(yystr) ); +} + +/** Setup the input buffer state to scan the given bytes. The next call to yylex() will + * scan from a @e copy of @a bytes. + * @param bytes the byte buffer to scan + * @param len the number of bytes in the buffer pointed to by @a bytes. + * + * @return the newly allocated buffer state object. + */ +YY_BUFFER_STATE yy_scan_bytes (yyconst char * yybytes, yy_size_t _yybytes_len ) +{ + YY_BUFFER_STATE b; + char *buf; + yy_size_t n, i; + + /* Get memory for full buffer, including space for trailing EOB's. */ + n = _yybytes_len + 2; + buf = (char *) yyalloc(n ); + if ( ! buf ) + YY_FATAL_ERROR( "out of dynamic memory in yy_scan_bytes()" ); + + for ( i = 0; i < _yybytes_len; ++i ) + buf[i] = yybytes[i]; + + buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR; + + b = yy_scan_buffer(buf,n ); + if ( ! b ) + YY_FATAL_ERROR( "bad buffer in yy_scan_bytes()" ); + + /* It's okay to grow etc. this buffer, and we should throw it + * away when we're done. + */ + b->yy_is_our_buffer = 1; + + return b; +} + +#ifndef YY_EXIT_FAILURE +#define YY_EXIT_FAILURE 2 +#endif + +static void yy_fatal_error (yyconst char* msg ) +{ + (void) fprintf( stderr, "%s\n", msg ); + exit( YY_EXIT_FAILURE ); +} + +/* Redefine yyless() so it works in section 3 code. */ + +#undef yyless +#define yyless(n) \ + do \ + { \ + /* Undo effects of setting up yytext. */ \ + int yyless_macro_arg = (n); \ + YY_LESS_LINENO(yyless_macro_arg);\ + yytext[yyleng] = (yy_hold_char); \ + (yy_c_buf_p) = yytext + yyless_macro_arg; \ + (yy_hold_char) = *(yy_c_buf_p); \ + *(yy_c_buf_p) = '\0'; \ + yyleng = yyless_macro_arg; \ + } \ + while ( 0 ) + +/* Accessor methods (get/set functions) to struct members. */ + +/** Get the current line number. + * + */ +int yyget_lineno (void) +{ + + return yylineno; +} + +/** Get the input stream. + * + */ +FILE *yyget_in (void) +{ + return yyin; +} + +/** Get the output stream. + * + */ +FILE *yyget_out (void) +{ + return yyout; +} + +/** Get the length of the current token. + * + */ +yy_size_t yyget_leng (void) +{ + return yyleng; +} + +/** Get the current token. + * + */ + +char *yyget_text (void) +{ + return yytext; +} + +/** Set the current line number. + * @param line_number + * + */ +void yyset_lineno (int line_number ) +{ + + yylineno = line_number; +} + +/** Set the input stream. This does not discard the current + * input buffer. + * @param in_str A readable stream. + * + * @see yy_switch_to_buffer + */ +void yyset_in (FILE * in_str ) +{ + yyin = in_str ; +} + +void yyset_out (FILE * out_str ) +{ + yyout = out_str ; +} + +int yyget_debug (void) +{ + return yy_flex_debug; +} + +void yyset_debug (int bdebug ) +{ + yy_flex_debug = bdebug ; +} + +static int yy_init_globals (void) +{ + /* Initialization is the same as for the non-reentrant scanner. + * This function is called from yylex_destroy(), so don't allocate here. + */ + + (yy_buffer_stack) = 0; + (yy_buffer_stack_top) = 0; + (yy_buffer_stack_max) = 0; + (yy_c_buf_p) = (char *) 0; + (yy_init) = 0; + (yy_start) = 0; + +/* Defined in main.c */ +#ifdef YY_STDINIT + yyin = stdin; + yyout = stdout; +#else + yyin = (FILE *) 0; + yyout = (FILE *) 0; +#endif + + /* For future reference: Set errno on error, since we are called by + * yylex_init() + */ + return 0; +} + +/* yylex_destroy is for both reentrant and non-reentrant scanners. */ +int yylex_destroy (void) +{ + + /* Pop the buffer stack, destroying each element. */ + while(YY_CURRENT_BUFFER){ + yy_delete_buffer(YY_CURRENT_BUFFER ); + YY_CURRENT_BUFFER_LVALUE = NULL; + yypop_buffer_state(); + } + + /* Destroy the stack itself. */ + yyfree((yy_buffer_stack) ); + (yy_buffer_stack) = NULL; + + /* Reset the globals. This is important in a non-reentrant scanner so the next time + * yylex() is called, initialization will occur. */ + yy_init_globals( ); + + return 0; +} + +/* + * Internal utility routines. + */ + +#ifndef yytext_ptr +static void yy_flex_strncpy (char* s1, yyconst char * s2, int n ) +{ + register int i; + for ( i = 0; i < n; ++i ) + s1[i] = s2[i]; +} +#endif + +#ifdef YY_NEED_STRLEN +static int yy_flex_strlen (yyconst char * s ) +{ + register int n; + for ( n = 0; s[n]; ++n ) + ; + + return n; +} +#endif + +void *yyalloc (yy_size_t size ) +{ + return (void *) malloc( size ); +} + +void *yyrealloc (void * ptr, yy_size_t size ) +{ + /* The cast to (char *) in the following accommodates both + * implementations that use char* generic pointers, and those + * that use void* generic pointers. It works with the latter + * because both ANSI C and C++ allow castless assignment from + * any pointer type to void*, and deal with argument conversions + * as though doing an assignment. + */ + return (void *) realloc( (char *) ptr, size ); +} + +void yyfree (void * ptr ) +{ + free( (char *) ptr ); /* see yyrealloc() for (char *) cast */ +} + +#define YYTABLES_NAME "yytables" + +#line 58 "kc.l" + + +CommentC() +{ char c; + int finished; + + finished=0; + while (finished==0) { + while (input()!='*') /* nothing */; + if ((c=input())=='/') finished=1; + } /* while */ +} /* Comment */ + +CommentPas() +{ char c; + int finished; + + finished=0; + while (finished==0) { + while (input()!='*') /* nothing */; + if ((c=input())==')') finished=1; + } /* while */ +} /* Comment */ + + +incl() { + + int i, start; + + i=8; + while (yytext[i]==' ') i++; + start=i; + while (yytext[i]!='\0') { yytext[i-start]=yytext[i]; i++; } + yytext[i]='\0'; +} /* incl */ + +num() { + + float temp; + int i; + + for(i=0; i +#ifdef _USE_GARBAGE_COL_ +# include +#else +# if _MALLOC_DEBUG_ +# include "malloc.h" +# else +# include +# endif +#endif +#include "codecall.h" +#include "misc.h" + +int mode; + +#include "parser.c" + +int main(int argc, char *argv[]) { + + int j, c; + extern char *optarg; + +#ifdef _MALLOC_DEBUG_ + union dbmalloptarg m; + dbmallopt(MALLOC_ERRFILE, m); +#endif + +#ifdef _PLATFORM_HPUX_ + mallopt(M_MXFAST, sizeof(Tree)); +#endif + + mode=DefaultMode; + printf("kc v%s, (C) Copyright by Kenneth Geisshirt and Keld Nielsen, 1992-1996\n", VERSION); + verbose=1; /* printing */ + while ((c=getopt(argc, argv, "vhdm:"))!=EOF) + switch (c) { + case 'h': + (void) printf("\nOptions:\n"); + (void) printf(" -h : this text.\n"); + (void) printf(" -v : verbose off\n"); + (void) printf(" -mx: mode\n"); + (void) printf(" 1 = Calculation of various properties\n"); + (void) printf(" 2 = KGadi\n"); + (void) printf(" 3 = kci\n"); + (void) printf(" 4 = Continuation program by I.Schreiber\n"); + (void) printf(" 5 = KnCont\n"); + (void) printf("E-mail: kneth@fatou.ruc.dk or kn@kiku.dk\n\n"); + (void) printf("This program comes with absolutely no warrenty!\n"); + exit(-1); + break; + case 'm': + j=0; + mode=0; + while ((optarg[j]!=' ') && (optarg[j]!='\0')) { + mode=mode*10+(int)(optarg[j]-'0'); + j++; + }; + break; + case 'v': + verbose=0; + break; + default: + (void) fprintf(stderr, "Warning: Option %1s ignored.\n", argv[i][1]); + break; + } /* switch */ + (void) yyparse(); + CodeGenCall(mode); +} diff --git a/src/matrix.h b/src/matrix.h new file mode 100644 index 0000000..d7a3ab6 --- /dev/null +++ b/src/matrix.h @@ -0,0 +1,82 @@ +/**************************************************************************** + Misc. routines for manipulating matrices and solving linear equations. + Matrices are assumed to be declared as **double and allocated by the + function MatrixAlloc. A matrix can be freed by MatrixFree. Similar for + vectors. + + CopyWrong 1994 by + Kenneth Geisshirt (kneth@fatou.ruc.dk) + Department of Life Sciences and Chemistry + Roskilde University + P.O. Box 260 + 4000 Roskilde + Denmark + + Last updated: 9 May 1995 by KN +*****************************************************************************/ + +#ifndef _MATRIX_LIB_ +#define _MATRIX_LIB_ + +#include "complex.h" + +#ifndef MALLOCTYPE /* init. the type used by free(3) */ +#ifdef _PLATFORM_DOS_ +#define MALLOCTYPE void +#endif +#ifdef _PLATFORM_GCC_ +#define MALLOCTYPE void +#endif +#ifdef _PLATFORM_HPUX_ +#define MALLOCTYPE char +#endif +#ifdef _PLATFORM_CONVEX_ +#define MALLOCTYPE void +#endif +#ifdef _PLATFORM_ULTRIX_ +#define MALLOCTYPE char +#endif +#ifdef _PLATFORM_SGI_ +#define MALLOCTYPE void +#endif +#ifdef _PLATFORM_LINUX_ +#define MALLOCTYPE void +#endif +#ifdef _PLATFORM_AIX_ +#define MALLOCTYPE void +#endif +#endif + +double **A_fixed; +double *x_fixed, *s_fixed; +int *p_fixed, n_fixed; + +extern double **MatrixAlloc(const int); +extern double *VectorAlloc(const int); +extern int *IntVectorAlloc(const int); +extern Complex *ComplexVectorAlloc(const int); +extern Complex **ComplexMatrixAlloc(const int); +extern void MatrixMul(const int, double **, double **, double **); +extern void Transpose(const int, double **, double **); +extern void MatrixFree(const int, double **); +extern void VectorFree(const int, double *); +extern void IntVectorFree(const int, int *); +extern void ComplexMatrixFree(const int, Complex **); +extern void ComplexVectorFree(const int, Complex *); +extern void LUfact(const int, double **, int *); +extern void LUsubst(const int, double **, int *, double *); +extern void LUfact_fixed(void); +extern void LUsubst_fixed(double *); +extern void LU_fixed_init(int); +extern void Tridiag(const int, double *, double *, double *, double *); +extern void GaussSeidel(const int, double **, double *, double *, + double, int); +extern void Jacobi(const int, double **, double *, double *, double, + int); +extern double DotProd(const int, double *, double *); +extern void MatrixVecProd(const int, double **, double *, double *); +extern void MatrixCopy(const int, double **, double **); +extern void GSR(const int, double **); +extern double L2VectorNorm(const int, double *); +extern void InversMatrix(const int, double **, double **); +#endif diff --git a/src/misc.c b/src/misc.c new file mode 100644 index 0000000..fea9772 --- /dev/null +++ b/src/misc.c @@ -0,0 +1,118 @@ +/*************************************************************************** + Misc. functions. + + CopyWrong 1993-1995 by + Kenneth Geisshirt (kneth@fatou.ruc.dk) + Department of Life Sciences and Chemistry + Roskilde University + P.O. Box 260 + 4000 Roskilde + Denmark + + See kc.tex for details. + + Last updated: 15 February 1995 by KG +****************************************************************************/ + +#include +#include +#include +#include "config.h" +#include "tableman.h" +#include "misc.h" + +void write0(char *str) { + + printf(str); + printf("\n"); +} + +void write1(char *str, double r0) { + + printf(str, r0); + printf("\n"); +} + +void write2(char *str, double r0, double r1) { + + printf(str, r0, r1); + printf("\n"); +} + +void write3(char *str, double r0, double r1, double r2) { + + printf(str, r0, r1, r2); + printf("\n"); +} + +void GetAndPrintConst(char *name, char *text, int type, double def, + FILE *output, int mode) { + + double temp; + char equal[10], line_end[10], prefix[10]; + + switch (mode) { + case 1: /* F77 */ + strcpy(equal, "="); + strcpy(line_end, ""); + strcpy(prefix, " "); + break; + case 2: /* Pascal */ + strcpy(equal, ":="); + strcpy(line_end, ";"); + strcpy(prefix, ""); + break; + case 3: /* C */ + strcpy(equal, "="); + strcpy(line_end, ";"); + strcpy(prefix, ""); + break; + } /* switch */ + + temp=GetConstant(name); + if (GetError()!=NoError) + temp=def; + switch (type) { + case 0: /* integer */ + fprintf(output, "%s%s%s%d%s\n", prefix, text, equal, (int)temp, line_end); + break; + case 1: /* real */ + fprintf(output, "%s%s%s%e%s\n", prefix, text, equal, temp, line_end); + break; + } /* switch */ +} /* GetAndPrintConst */ + + +int Fact(int n) { + + int i, temp = 1; + + for(i=2; i<=n; i++) + temp*=i; + return temp; +} + +int ipower(int x, int n) { + + int i, temp; + + temp=x; + for(i=2; i<=n; i++) + temp*=x; + return temp; +} + +char *StringAlloc(void) { + + char *temp; + + temp=(char *)calloc(STRING_LENGTH, sizeof(char)); + if (temp==NULL) + fprintf(stderr, "Error in StringAlloc: No space for string.\n"); + return (temp); +} /* StringAlloc */ + +void StringFree(char *str) { + + free((MALLOCTYPE *)str); +} /* StringFree */ diff --git a/src/misc.h b/src/misc.h new file mode 100644 index 0000000..d257a33 --- /dev/null +++ b/src/misc.h @@ -0,0 +1,31 @@ +/************************************************************************** + Misc. routines for kc. + + CopyWrong 1993-1995 by + Kenneth Geisshirt (kneth@fatou.ruc.dk) + Department of Life Sciences and Chemistry + Roskilde University + 4000 Roskilde + Denmark + + See kc.tex for details. + + Last updated: 15 February 1995 by KG +****************************************************************************/ + +#ifndef _MISC_ +#define _MISC_ + +#include + +int verbose; /* 1==verbose on */ +extern void write0(char *); +extern void write1(char *, double); +extern void write2(char *, double, double); +extern void write3(char *, double, double, double); +extern void GetAndPrintConst(char *, char *, int, double, FILE *, int); +extern int Fact(int); +extern int ipower(int, int); +extern char *StringAlloc(void); +extern void StringFree(char *); +#endif diff --git a/src/mixed.c b/src/mixed.c new file mode 100644 index 0000000..76aae9a --- /dev/null +++ b/src/mixed.c @@ -0,0 +1,380 @@ +/************************************************************************* + Mixed - a code generator for kc. + + CopyWrong 1993-1995 by + Keld Nielsen (kn@kin.kiku.dk) + Department of Theoretical Chemistry + University of Copenhagen + Universitetsparken 5 + 2100 Copenhagen + Denmark + + See kc.tex for details + + Last updated: 8 Nov 1995 by KG +*************************************************************************/ + +#include +#include +#include +#include "config.h" +#include "symbmath.h" +#include "tableman.h" +#include "misc.h" +#include "codegen.h" +#include "eigen.h" +#include "complex.h" +#include "matrix.h" + +void Mixed(void) { + + double charge, temp; + char *name, *rename; + Tree tmp; + int i, j, l, k, no_eval, ref; + int num_of_spec, max_iter,num_of_reac; + double angle,eps, sum_left, sum_right, sumfw, sumrv,sumfw_im,sumrv_im; + double qd, fd; + double leftsc,rightsc; + double *am,*ph,*fu,*qu; + double *stconc, *reacfw_, *reacrv_, *flowfw, *flowrv; + double **jac_num; + double **QP, **INVQP; + double **reacfwds_, **reacrvds_; + Complex z_,*values, **vectors; + + name=StringAlloc(); + rename=StringAlloc(); + + num_of_spec=NoOfSpec()+NumOfDynVar()-NumOfConstraint(); + num_of_reac= NoOfReact(); + jac_num= MatrixAlloc(num_of_spec); + QP= MatrixAlloc(num_of_spec); + INVQP= MatrixAlloc(num_of_spec); + am= VectorAlloc(num_of_spec); + ph= VectorAlloc(num_of_spec); + fu= VectorAlloc(num_of_spec); + qu= VectorAlloc(num_of_spec); + reacfw_= VectorAlloc(num_of_reac); + reacrv_= VectorAlloc(num_of_reac); + flowfw= VectorAlloc(num_of_reac); + flowrv= VectorAlloc(num_of_reac); + stconc= VectorAlloc(num_of_spec); + values=ComplexVectorAlloc(num_of_spec); + vectors=ComplexMatrixAlloc(num_of_spec); + + if (num_of_spec>num_of_reac) { + reacfwds_= MatrixAlloc(num_of_spec); + reacrvds_= MatrixAlloc(num_of_spec); + } else { + reacfwds_= MatrixAlloc(num_of_reac); + reacrvds_= MatrixAlloc(num_of_reac); + } + + InitCodeGenVar(num_of_spec, NumOfConstraint(),NoOfReact()); + GenerateRateExpr(); + GenerateJacobi(); + GenerateDiffReac(); + + temp=GetConstant("mixed"); + if (GetError()==NoError) + no_eval= (int) temp; + else + no_eval= 0; + + temp=GetConstant("epsa"); + if (GetError()==NoError) + eps=temp; + else + temp=1.0e-18; + temp=GetConstant("maxiter"); + if (GetError()==NoError) + max_iter=(int)temp; + else + max_iter=30; + temp=GetConstant("ref"); + if (GetError()==NoError) + ref=(int)temp; + else + ref=1; + + for(i=0; inum_of_reac) { + MatrixFree(num_of_spec,reacfwds_); + MatrixFree(num_of_spec,reacrvds_); + } else { + MatrixFree(num_of_reac,reacfwds_); + MatrixFree(num_of_reac,reacrvds_); + } +} /* Mixed */ diff --git a/src/mixed.h b/src/mixed.h new file mode 100644 index 0000000..a74a3c3 --- /dev/null +++ b/src/mixed.h @@ -0,0 +1,11 @@ +/* Finn - a code generator for kc. + CopyWrong Kenneth Geisshirt 1993 + + See kc.tex for details. +*/ + +#ifndef _MIXED_ +#define _MIXED_ + +extern void Mixed(void); +#endif diff --git a/src/parser.c b/src/parser.c new file mode 100644 index 0000000..7a4a3ea --- /dev/null +++ b/src/parser.c @@ -0,0 +1,2498 @@ +/* A Bison parser, made by GNU Bison 2.3. */ + +/* Skeleton implementation for Bison's Yacc-like parsers in C + + Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006 + Free Software Foundation, Inc. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, + Boston, MA 02110-1301, USA. */ + +/* As a special exception, you may create a larger work that contains + part or all of the Bison parser skeleton and distribute that work + under terms of your choice, so long as that work isn't itself a + parser generator using the skeleton or a modified version thereof + as a parser skeleton. Alternatively, if you modify or redistribute + the parser skeleton itself, you may (at your option) remove this + special exception, which will cause the skeleton and the resulting + Bison output files to be licensed under the GNU General Public + License without this special exception. + + This special exception was added by the Free Software Foundation in + version 2.2 of Bison. */ + +/* C LALR(1) parser skeleton written by Richard Stallman, by + simplifying the original so-called "semantic" parser. */ + +/* All symbols defined below should begin with yy or YY, to avoid + infringing on user name space. This should be done even for local + variables, as they might otherwise be expanded by user macros. + There are some unavoidable exceptions within include files to + define necessary library symbols; they are noted "INFRINGES ON + USER NAME SPACE" below. */ + +/* Identify Bison output. */ +#define YYBISON 1 + +/* Bison version. */ +#define YYBISON_VERSION "2.3" + +/* Skeleton name. */ +#define YYSKELETON_NAME "yacc.c" + +/* Pure parsers. */ +#define YYPURE 0 + +/* Using locations. */ +#define YYLSP_NEEDED 0 + + + +/* Tokens. */ +#ifndef YYTOKENTYPE +# define YYTOKENTYPE + /* Put the tokens into the symbol table, so that GDB and other debuggers + know about them. */ + enum yytokentype { + names = 258, + leftarr = 259, + rightarr = 260, + numbers = 261, + param = 262, + print = 263, + powop = 264, + semicolon = 265, + quotation = 266, + equal = 267, + colon = 268, + R = 269, + E = 270, + powc = 271, + leftpar = 272, + rightpar = 273, + oneway = 274, + twoways = 275, + plus = 276, + minus = 277, + multi = 278, + pdiv = 279, + comma = 280, + leftconc = 281, + rightconc = 282, + time0 = 283, + K = 284, + radical = 285, + V = 286, + prime = 287, + fun_exp = 288, + fun_log = 289, + fun_ln = 290, + fun_sin = 291, + fun_cos = 292, + fun_tan = 293, + fun_sinh = 294, + fun_cosh = 295, + fun_tanh = 296, + fun_asin = 297, + fun_acos = 298, + fun_atan = 299, + fun_asinh = 300, + fun_acosh = 301, + fun_atanh = 302, + UMINUS = 303 + }; +#endif +/* Tokens. */ +#define names 258 +#define leftarr 259 +#define rightarr 260 +#define numbers 261 +#define param 262 +#define print 263 +#define powop 264 +#define semicolon 265 +#define quotation 266 +#define equal 267 +#define colon 268 +#define R 269 +#define E 270 +#define powc 271 +#define leftpar 272 +#define rightpar 273 +#define oneway 274 +#define twoways 275 +#define plus 276 +#define minus 277 +#define multi 278 +#define pdiv 279 +#define comma 280 +#define leftconc 281 +#define rightconc 282 +#define time0 283 +#define K 284 +#define radical 285 +#define V 286 +#define prime 287 +#define fun_exp 288 +#define fun_log 289 +#define fun_ln 290 +#define fun_sin 291 +#define fun_cos 292 +#define fun_tan 293 +#define fun_sinh 294 +#define fun_cosh 295 +#define fun_tanh 296 +#define fun_asin 297 +#define fun_acos 298 +#define fun_atan 299 +#define fun_asinh 300 +#define fun_acosh 301 +#define fun_atanh 302 +#define UMINUS 303 + + + + +/* Copy the first part of user declarations. */ +#line 1 "kc.y" + +/********************************************************* + Parser to kc. + CopyWrong 1992-1995 by + Kenneth Geisshirt (kneth@fatou.ruc.dk) + Department of Life Sciences and Chemistry + Roskilde University + P.O. Box 260 + 4000 Roskilde + Denmark + + + See kc.tex for details. + + Last updated: 17 February 1994 +**********************************************************/ + +#include "config.h" + +#include +#include +#include +#include "symbmath.h" +#include "tableman.h" +#include "codecall.h" + +typedef enum {no, ini, ord} Conc; + +typedef struct compound { + char name[STRING_LENGTH]; + double charge; + Conc concs; +} compound; + +typedef struct Strnum { + int flag; + char name[STRING_LENGTH]; + double numb; +} Strnum; + +double coeff, charge, value, temp, temp1, temp2; +char flag, name[STRING_LENGTH], string[STRING_LENGTH]; +int i, j, side, lineno=1; +Tree tmp; + + +/* Enabling traces. */ +#ifndef YYDEBUG +# define YYDEBUG 0 +#endif + +/* Enabling verbose error messages. */ +#ifdef YYERROR_VERBOSE +# undef YYERROR_VERBOSE +# define YYERROR_VERBOSE 1 +#else +# define YYERROR_VERBOSE 0 +#endif + +/* Enabling the token table. */ +#ifndef YYTOKEN_TABLE +# define YYTOKEN_TABLE 0 +#endif + +#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED +typedef union YYSTYPE +#line 47 "kc.y" +{ + double dval; + char oper; + char name[STRING_LENGTH]; + compound comp; + char flag; + Tree tree; + Function func; + Strnum strnum; +} +/* Line 193 of yacc.c. */ +#line 249 "y.tab.c" + YYSTYPE; +# define yystype YYSTYPE /* obsolescent; will be withdrawn */ +# define YYSTYPE_IS_DECLARED 1 +# define YYSTYPE_IS_TRIVIAL 1 +#endif + + + +/* Copy the second part of user declarations. */ + + +/* Line 216 of yacc.c. */ +#line 262 "y.tab.c" + +#ifdef short +# undef short +#endif + +#ifdef YYTYPE_UINT8 +typedef YYTYPE_UINT8 yytype_uint8; +#else +typedef unsigned char yytype_uint8; +#endif + +#ifdef YYTYPE_INT8 +typedef YYTYPE_INT8 yytype_int8; +#elif (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +typedef signed char yytype_int8; +#else +typedef short int yytype_int8; +#endif + +#ifdef YYTYPE_UINT16 +typedef YYTYPE_UINT16 yytype_uint16; +#else +typedef unsigned short int yytype_uint16; +#endif + +#ifdef YYTYPE_INT16 +typedef YYTYPE_INT16 yytype_int16; +#else +typedef short int yytype_int16; +#endif + +#ifndef YYSIZE_T +# ifdef __SIZE_TYPE__ +# define YYSIZE_T __SIZE_TYPE__ +# elif defined size_t +# define YYSIZE_T size_t +# elif ! defined YYSIZE_T && (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +# include /* INFRINGES ON USER NAME SPACE */ +# define YYSIZE_T size_t +# else +# define YYSIZE_T unsigned int +# endif +#endif + +#define YYSIZE_MAXIMUM ((YYSIZE_T) -1) + +#ifndef YY_ +# if defined YYENABLE_NLS && YYENABLE_NLS +# if ENABLE_NLS +# include /* INFRINGES ON USER NAME SPACE */ +# define YY_(msgid) dgettext ("bison-runtime", msgid) +# endif +# endif +# ifndef YY_ +# define YY_(msgid) msgid +# endif +#endif + +/* Suppress unused-variable warnings by "using" E. */ +#if ! defined lint || defined __GNUC__ +# define YYUSE(e) ((void) (e)) +#else +# define YYUSE(e) /* empty */ +#endif + +/* Identity function, used to suppress warnings about constant conditions. */ +#ifndef lint +# define YYID(n) (n) +#else +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static int +YYID (int i) +#else +static int +YYID (i) + int i; +#endif +{ + return i; +} +#endif + +#if ! defined yyoverflow || YYERROR_VERBOSE + +/* The parser invokes alloca or malloc; define the necessary symbols. */ + +# ifdef YYSTACK_USE_ALLOCA +# if YYSTACK_USE_ALLOCA +# ifdef __GNUC__ +# define YYSTACK_ALLOC __builtin_alloca +# elif defined __BUILTIN_VA_ARG_INCR +# include /* INFRINGES ON USER NAME SPACE */ +# elif defined _AIX +# define YYSTACK_ALLOC __alloca +# elif defined _MSC_VER +# include /* INFRINGES ON USER NAME SPACE */ +# define alloca _alloca +# else +# define YYSTACK_ALLOC alloca +# if ! defined _ALLOCA_H && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +# include /* INFRINGES ON USER NAME SPACE */ +# ifndef _STDLIB_H +# define _STDLIB_H 1 +# endif +# endif +# endif +# endif +# endif + +# ifdef YYSTACK_ALLOC + /* Pacify GCC's `empty if-body' warning. */ +# define YYSTACK_FREE(Ptr) do { /* empty */; } while (YYID (0)) +# ifndef YYSTACK_ALLOC_MAXIMUM + /* The OS might guarantee only one guard page at the bottom of the stack, + and a page size can be as small as 4096 bytes. So we cannot safely + invoke alloca (N) if N exceeds 4096. Use a slightly smaller number + to allow for a few compiler-allocated temporary stack slots. */ +# define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */ +# endif +# else +# define YYSTACK_ALLOC YYMALLOC +# define YYSTACK_FREE YYFREE +# ifndef YYSTACK_ALLOC_MAXIMUM +# define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM +# endif +# if (defined __cplusplus && ! defined _STDLIB_H \ + && ! ((defined YYMALLOC || defined malloc) \ + && (defined YYFREE || defined free))) +# include /* INFRINGES ON USER NAME SPACE */ +# ifndef _STDLIB_H +# define _STDLIB_H 1 +# endif +# endif +# ifndef YYMALLOC +# define YYMALLOC malloc +# if ! defined malloc && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */ +# endif +# endif +# ifndef YYFREE +# define YYFREE free +# if ! defined free && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +void free (void *); /* INFRINGES ON USER NAME SPACE */ +# endif +# endif +# endif +#endif /* ! defined yyoverflow || YYERROR_VERBOSE */ + + +#if (! defined yyoverflow \ + && (! defined __cplusplus \ + || (defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL))) + +/* A type that is properly aligned for any stack member. */ +union yyalloc +{ + yytype_int16 yyss; + YYSTYPE yyvs; + }; + +/* The size of the maximum gap between one aligned stack and the next. */ +# define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1) + +/* The size of an array large to enough to hold all stacks, each with + N elements. */ +# define YYSTACK_BYTES(N) \ + ((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE)) \ + + YYSTACK_GAP_MAXIMUM) + +/* Copy COUNT objects from FROM to TO. The source and destination do + not overlap. */ +# ifndef YYCOPY +# if defined __GNUC__ && 1 < __GNUC__ +# define YYCOPY(To, From, Count) \ + __builtin_memcpy (To, From, (Count) * sizeof (*(From))) +# else +# define YYCOPY(To, From, Count) \ + do \ + { \ + YYSIZE_T yyi; \ + for (yyi = 0; yyi < (Count); yyi++) \ + (To)[yyi] = (From)[yyi]; \ + } \ + while (YYID (0)) +# endif +# endif + +/* Relocate STACK from its old location to the new one. The + local variables YYSIZE and YYSTACKSIZE give the old and new number of + elements in the stack, and YYPTR gives the new location of the + stack. Advance YYPTR to a properly aligned location for the next + stack. */ +# define YYSTACK_RELOCATE(Stack) \ + do \ + { \ + YYSIZE_T yynewbytes; \ + YYCOPY (&yyptr->Stack, Stack, yysize); \ + Stack = &yyptr->Stack; \ + yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \ + yyptr += yynewbytes / sizeof (*yyptr); \ + } \ + while (YYID (0)) + +#endif + +/* YYFINAL -- State number of the termination state. */ +#define YYFINAL 3 +/* YYLAST -- Last index in YYTABLE. */ +#define YYLAST 301 + +/* YYNTOKENS -- Number of terminals. */ +#define YYNTOKENS 49 +/* YYNNTS -- Number of nonterminals. */ +#define YYNNTS 34 +/* YYNRULES -- Number of rules. */ +#define YYNRULES 83 +/* YYNRULES -- Number of states. */ +#define YYNSTATES 175 + +/* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX. */ +#define YYUNDEFTOK 2 +#define YYMAXUTOK 303 + +#define YYTRANSLATE(YYX) \ + ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK) + +/* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX. */ +static const yytype_uint8 yytranslate[] = +{ + 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 1, 2, 3, 4, + 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, + 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, + 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, + 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, + 45, 46, 47, 48 +}; + +#if YYDEBUG +/* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in + YYRHS. */ +static const yytype_uint16 yyprhs[] = +{ + 0, 0, 3, 4, 9, 12, 13, 15, 17, 21, + 25, 28, 33, 37, 39, 41, 43, 47, 61, 75, + 77, 80, 81, 82, 92, 98, 102, 104, 108, 110, + 117, 118, 125, 129, 130, 135, 137, 139, 141, 144, + 149, 152, 156, 157, 159, 162, 164, 166, 168, 170, + 171, 173, 176, 182, 190, 196, 199, 203, 207, 211, + 215, 219, 223, 225, 227, 230, 235, 237, 239, 241, + 243, 245, 247, 249, 251, 253, 255, 257, 259, 261, + 263, 265, 269, 270 +}; + +/* YYRHS -- A `-1'-separated list of the rules' RHS. */ +static const yytype_int8 yyrhs[] = +{ + 50, 0, -1, -1, 51, 52, 60, 77, -1, 52, + 53, -1, -1, 54, -1, 58, -1, 8, 56, 10, + -1, 3, 12, 55, -1, 79, 10, -1, 11, 3, + 11, 10, -1, 56, 25, 57, -1, 57, -1, 3, + -1, 81, -1, 7, 59, 10, -1, 3, 12, 79, + 25, 79, 25, 79, 25, 79, 25, 79, 25, 79, + -1, 81, 12, 79, 25, 79, 25, 79, 25, 79, + 25, 79, 25, 79, -1, 61, -1, 60, 61, -1, + -1, -1, 6, 62, 13, 71, 70, 63, 71, 10, + 64, -1, 3, 32, 12, 79, 10, -1, 65, 10, + 67, -1, 67, -1, 65, 10, 66, -1, 66, -1, + 3, 17, 72, 18, 12, 79, -1, -1, 4, 12, + 79, 68, 10, 69, -1, 3, 12, 79, -1, -1, + 5, 12, 79, 10, -1, 19, -1, 20, -1, 12, + -1, 76, 72, -1, 71, 21, 76, 72, -1, 3, + 73, -1, 17, 74, 18, -1, -1, 30, -1, 75, + 6, -1, 75, -1, 21, -1, 22, -1, 6, -1, + -1, 78, -1, 77, 78, -1, 81, 82, 12, 79, + 10, -1, 3, 17, 72, 18, 12, 79, 10, -1, + 3, 82, 12, 79, 10, -1, 22, 79, -1, 79, + 21, 79, -1, 79, 22, 79, -1, 79, 23, 79, + -1, 79, 24, 79, -1, 79, 9, 79, -1, 17, + 79, 18, -1, 3, -1, 6, -1, 81, 82, -1, + 80, 17, 79, 18, -1, 33, -1, 35, -1, 34, + -1, 36, -1, 37, -1, 38, -1, 39, -1, 40, + -1, 41, -1, 42, -1, 43, -1, 44, -1, 45, + -1, 46, -1, 47, -1, 26, 72, 27, -1, -1, + 28, -1 +}; + +/* YYRLINE[YYN] -- source line where rule number YYN was defined. */ +static const yytype_uint16 yyrline[] = +{ + 0, 116, 116, 116, 185, 186, 187, 188, 189, 190, + 197, 207, 211, 212, 213, 215, 217, 218, 252, 283, + 284, 286, 290, 285, 305, 310, 311, 312, 313, 314, + 327, 326, 338, 346, 348, 362, 363, 364, 365, 370, + 375, 381, 383, 386, 390, 400, 406, 407, 408, 413, + 416, 417, 418, 433, 441, 453, 459, 466, 473, 481, + 489, 496, 501, 512, 516, 533, 539, 540, 541, 542, + 543, 544, 545, 546, 547, 548, 549, 550, 551, 552, + 553, 554, 560, 561 +}; +#endif + +#if YYDEBUG || YYERROR_VERBOSE || YYTOKEN_TABLE +/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM. + First, the terminals, then, starting at YYNTOKENS, nonterminals. */ +static const char *const yytname[] = +{ + "$end", "error", "$undefined", "names", "leftarr", "rightarr", + "numbers", "param", "print", "powop", "semicolon", "quotation", "equal", + "colon", "R", "E", "powc", "leftpar", "rightpar", "oneway", "twoways", + "plus", "minus", "multi", "pdiv", "comma", "leftconc", "rightconc", + "time0", "K", "radical", "V", "prime", "fun_exp", "fun_log", "fun_ln", + "fun_sin", "fun_cos", "fun_tan", "fun_sinh", "fun_cosh", "fun_tanh", + "fun_asin", "fun_acos", "fun_atan", "fun_asinh", "fun_acosh", + "fun_atanh", "UMINUS", "$accept", "system", "@1", "declars", "declar", + "constant", "strnumb", "printlist", "prn_entry", "parameter", "pentry", + "reactions", "reaction", "@2", "@3", "reackonst", "powconsts", + "powconst", "rateconsts", "@4", "ropt", "kind", "substs", "subst", + "charge", "size", "sign", "coeff", "constants", "const", "expr", + "function", "conc", "timeopt", 0 +}; +#endif + +# ifdef YYPRINT +/* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to + token YYLEX-NUM. */ +static const yytype_uint16 yytoknum[] = +{ + 0, 256, 257, 258, 259, 260, 261, 262, 263, 264, + 265, 266, 267, 268, 269, 270, 271, 272, 273, 274, + 275, 276, 277, 278, 279, 280, 281, 282, 283, 284, + 285, 286, 287, 288, 289, 290, 291, 292, 293, 294, + 295, 296, 297, 298, 299, 300, 301, 302, 303 +}; +# endif + +/* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */ +static const yytype_uint8 yyr1[] = +{ + 0, 49, 51, 50, 52, 52, 53, 53, 53, 54, + 55, 55, 56, 56, 57, 57, 58, 59, 59, 60, + 60, 62, 63, 61, 61, 64, 64, 65, 65, 66, + 68, 67, 67, 69, 69, 70, 70, 70, 71, 71, + 72, 73, 73, 74, 74, 74, 75, 75, 76, 76, + 77, 77, 78, 78, 78, 79, 79, 79, 79, 79, + 79, 79, 79, 79, 79, 79, 80, 80, 80, 80, + 80, 80, 80, 80, 80, 80, 80, 80, 80, 80, + 80, 81, 82, 82 +}; + +/* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN. */ +static const yytype_uint8 yyr2[] = +{ + 0, 2, 0, 4, 2, 0, 1, 1, 3, 3, + 2, 4, 3, 1, 1, 1, 3, 13, 13, 1, + 2, 0, 0, 9, 5, 3, 1, 3, 1, 6, + 0, 6, 3, 0, 4, 1, 1, 1, 2, 4, + 2, 3, 0, 1, 2, 1, 1, 1, 1, 0, + 1, 2, 5, 7, 5, 2, 3, 3, 3, 3, + 3, 3, 1, 1, 2, 4, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 3, 0, 1 +}; + +/* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state + STATE-NUM when YYTABLE doesn't specify something else to do. Zero + means the default is an error. */ +static const yytype_uint8 yydefact[] = +{ + 2, 0, 5, 1, 0, 0, 21, 0, 0, 4, + 6, 7, 0, 19, 0, 0, 0, 0, 0, 0, + 0, 14, 0, 13, 15, 82, 20, 3, 50, 82, + 62, 63, 0, 0, 0, 66, 68, 67, 69, 70, + 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, + 9, 0, 0, 82, 0, 49, 0, 42, 0, 16, + 0, 8, 0, 0, 83, 0, 82, 51, 0, 0, + 0, 55, 0, 10, 0, 0, 0, 0, 0, 64, + 0, 48, 0, 0, 0, 0, 40, 81, 0, 12, + 0, 0, 0, 0, 61, 60, 56, 57, 58, 59, + 0, 24, 37, 35, 36, 49, 22, 38, 0, 46, + 47, 43, 0, 45, 0, 0, 0, 0, 11, 65, + 0, 49, 0, 41, 44, 0, 0, 54, 52, 39, + 0, 0, 0, 0, 0, 0, 0, 53, 0, 0, + 23, 0, 28, 26, 0, 0, 0, 0, 0, 0, + 0, 0, 32, 0, 30, 27, 25, 0, 0, 0, + 0, 0, 0, 0, 33, 0, 0, 29, 0, 31, + 17, 18, 0, 0, 34 +}; + +/* YYDEFGOTO[NTERM-NUM]. */ +static const yytype_int16 yydefgoto[] = +{ + -1, 1, 2, 4, 9, 10, 50, 22, 23, 11, + 19, 12, 13, 16, 121, 140, 141, 142, 143, 160, + 169, 106, 82, 58, 86, 112, 113, 83, 27, 28, + 51, 52, 53, 65 +}; + +/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing + STATE-NUM. */ +#define YYPACT_NINF -60 +static const yytype_int16 yypact[] = +{ + -60, 30, -60, -60, 12, -6, -60, 6, 7, -60, + -60, -60, 5, -60, 120, 24, 55, 26, 34, 59, + 60, -60, 3, -60, -60, 45, -60, 9, -60, 46, + -60, -60, 77, 165, 165, -60, -60, -60, -60, -60, + -60, -60, -60, -60, -60, -60, -60, -60, -60, -60, + -60, 214, 75, 46, 165, 90, 165, 97, 70, -60, + 165, -60, 7, 34, -60, 104, -3, -60, 105, 107, + 230, -60, 165, -60, 165, 165, 165, 165, 165, -60, + 234, -60, 108, 34, 25, 57, -60, -60, 31, -60, + 101, 165, 165, 111, -60, -60, 67, 67, 113, 113, + 241, -60, -60, -60, -60, 90, -60, -60, 165, -60, + -60, -60, 116, 130, 165, 128, 251, 257, -60, -60, + 34, 90, 42, -60, -60, 61, 165, -60, -60, -60, + 50, 165, 165, 261, 13, 80, 85, -60, 83, 129, + -60, 133, -60, -60, 165, 165, 165, 34, 165, 13, + 126, 171, 277, 127, 277, -60, -60, 165, 165, 132, + 142, 204, 209, 165, 164, 165, 165, 277, 158, -60, + 277, 277, 165, 267, -60 +}; + +/* YYPGOTO[NTERM-NUM]. */ +static const yytype_int16 yypgoto[] = +{ + -60, -60, -60, -60, -60, -60, -60, -60, 76, -60, + -60, -60, 160, -60, -60, -60, -60, 27, 28, -60, + -60, -60, 52, -59, -60, -60, -60, 69, -60, 148, + -33, -60, -5, -24 +}; + +/* YYTABLE[YYPACT[STATE-NUM]]. What to do in state STATE-NUM. If + positive, shift that token. If negative, reduce the rule which + number is the opposite. If zero, do what YYDEFACT says. + If YYTABLE_NINF, syntax error. */ +#define YYTABLE_NINF -1 +static const yytype_uint8 yytable[] = +{ + 70, 71, 20, 24, 90, 68, 14, 29, 25, 17, + 21, 6, 66, 61, 63, 5, 138, 139, 6, 7, + 8, 80, 29, 84, 107, 64, 15, 88, 62, 79, + 3, 18, 18, 18, 72, 18, 54, 57, 56, 95, + 72, 96, 97, 98, 99, 100, 74, 75, 76, 77, + 108, 72, 74, 75, 76, 77, 114, 24, 116, 117, + 134, 129, 63, 74, 75, 76, 77, 131, 55, 59, + 72, 105, 60, 64, 64, 122, 72, 15, 109, 110, + 69, 125, 74, 75, 76, 77, 132, 111, 153, 72, + 76, 77, 78, 133, 72, 146, 81, 87, 135, 136, + 147, 74, 75, 76, 77, 144, 74, 75, 76, 77, + 145, 150, 151, 152, 85, 154, 91, 92, 93, 115, + 102, 118, 72, 30, 161, 162, 31, 103, 104, 105, + 167, 32, 170, 171, 123, 72, 124, 33, 89, 173, + 126, 148, 34, 149, 163, 159, 18, 74, 75, 76, + 77, 157, 164, 35, 36, 37, 38, 39, 40, 41, + 42, 43, 44, 45, 46, 47, 48, 49, 30, 168, + 172, 31, 26, 130, 120, 67, 155, 156, 0, 0, + 72, 0, 33, 0, 0, 0, 0, 34, 0, 0, + 0, 18, 74, 75, 76, 77, 158, 0, 35, 36, + 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, + 47, 48, 49, 72, 0, 0, 0, 0, 72, 0, + 0, 0, 0, 72, 73, 74, 75, 76, 77, 165, + 74, 75, 76, 77, 166, 74, 75, 76, 77, 72, + 0, 0, 0, 72, 101, 0, 0, 0, 94, 0, + 72, 74, 75, 76, 77, 74, 75, 76, 77, 119, + 72, 127, 74, 75, 76, 77, 72, 128, 0, 0, + 72, 137, 74, 75, 76, 77, 72, 174, 74, 75, + 76, 77, 74, 75, 76, 77, 72, 0, 74, 75, + 76, 77, 0, 0, 0, 0, 0, 0, 74, 75, + 76, 77 +}; + +static const yytype_int16 yycheck[] = +{ + 33, 34, 7, 8, 63, 29, 12, 12, 3, 3, + 3, 6, 3, 10, 17, 3, 3, 4, 6, 7, + 8, 54, 27, 56, 83, 28, 32, 60, 25, 53, + 0, 26, 26, 26, 9, 26, 12, 3, 12, 72, + 9, 74, 75, 76, 77, 78, 21, 22, 23, 24, + 25, 9, 21, 22, 23, 24, 25, 62, 91, 92, + 10, 120, 17, 21, 22, 23, 24, 25, 13, 10, + 9, 21, 12, 28, 28, 108, 9, 32, 21, 22, + 3, 114, 21, 22, 23, 24, 25, 30, 147, 9, + 23, 24, 17, 126, 9, 12, 6, 27, 131, 132, + 17, 21, 22, 23, 24, 25, 21, 22, 23, 24, + 25, 144, 145, 146, 17, 148, 12, 12, 11, 18, + 12, 10, 9, 3, 157, 158, 6, 19, 20, 21, + 163, 11, 165, 166, 18, 9, 6, 17, 62, 172, + 12, 12, 22, 10, 12, 18, 26, 21, 22, 23, + 24, 25, 10, 33, 34, 35, 36, 37, 38, 39, + 40, 41, 42, 43, 44, 45, 46, 47, 3, 5, + 12, 6, 12, 121, 105, 27, 149, 149, -1, -1, + 9, -1, 17, -1, -1, -1, -1, 22, -1, -1, + -1, 26, 21, 22, 23, 24, 25, -1, 33, 34, + 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, + 45, 46, 47, 9, -1, -1, -1, -1, 9, -1, + -1, -1, -1, 9, 10, 21, 22, 23, 24, 25, + 21, 22, 23, 24, 25, 21, 22, 23, 24, 9, + -1, -1, -1, 9, 10, -1, -1, -1, 18, -1, + 9, 21, 22, 23, 24, 21, 22, 23, 24, 18, + 9, 10, 21, 22, 23, 24, 9, 10, -1, -1, + 9, 10, 21, 22, 23, 24, 9, 10, 21, 22, + 23, 24, 21, 22, 23, 24, 9, -1, 21, 22, + 23, 24, -1, -1, -1, -1, -1, -1, 21, 22, + 23, 24 +}; + +/* YYSTOS[STATE-NUM] -- The (internal number of the) accessing + symbol of state STATE-NUM. */ +static const yytype_uint8 yystos[] = +{ + 0, 50, 51, 0, 52, 3, 6, 7, 8, 53, + 54, 58, 60, 61, 12, 32, 62, 3, 26, 59, + 81, 3, 56, 57, 81, 3, 61, 77, 78, 81, + 3, 6, 11, 17, 22, 33, 34, 35, 36, 37, + 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, + 55, 79, 80, 81, 12, 13, 12, 3, 72, 10, + 12, 10, 25, 17, 28, 82, 3, 78, 82, 3, + 79, 79, 9, 10, 21, 22, 23, 24, 17, 82, + 79, 6, 71, 76, 79, 17, 73, 27, 79, 57, + 72, 12, 12, 11, 18, 79, 79, 79, 79, 79, + 79, 10, 12, 19, 20, 21, 70, 72, 25, 21, + 22, 30, 74, 75, 25, 18, 79, 79, 10, 18, + 76, 63, 79, 18, 6, 79, 12, 10, 10, 72, + 71, 25, 25, 79, 10, 79, 79, 10, 3, 4, + 64, 65, 66, 67, 25, 25, 12, 17, 12, 10, + 79, 79, 79, 72, 79, 66, 67, 25, 25, 18, + 68, 79, 79, 12, 10, 25, 25, 79, 5, 69, + 79, 79, 12, 79, 10 +}; + +#define yyerrok (yyerrstatus = 0) +#define yyclearin (yychar = YYEMPTY) +#define YYEMPTY (-2) +#define YYEOF 0 + +#define YYACCEPT goto yyacceptlab +#define YYABORT goto yyabortlab +#define YYERROR goto yyerrorlab + + +/* Like YYERROR except do call yyerror. This remains here temporarily + to ease the transition to the new meaning of YYERROR, for GCC. + Once GCC version 2 has supplanted version 1, this can go. */ + +#define YYFAIL goto yyerrlab + +#define YYRECOVERING() (!!yyerrstatus) + +#define YYBACKUP(Token, Value) \ +do \ + if (yychar == YYEMPTY && yylen == 1) \ + { \ + yychar = (Token); \ + yylval = (Value); \ + yytoken = YYTRANSLATE (yychar); \ + YYPOPSTACK (1); \ + goto yybackup; \ + } \ + else \ + { \ + yyerror (YY_("syntax error: cannot back up")); \ + YYERROR; \ + } \ +while (YYID (0)) + + +#define YYTERROR 1 +#define YYERRCODE 256 + + +/* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N]. + If N is 0, then set CURRENT to the empty location which ends + the previous symbol: RHS[0] (always defined). */ + +#define YYRHSLOC(Rhs, K) ((Rhs)[K]) +#ifndef YYLLOC_DEFAULT +# define YYLLOC_DEFAULT(Current, Rhs, N) \ + do \ + if (YYID (N)) \ + { \ + (Current).first_line = YYRHSLOC (Rhs, 1).first_line; \ + (Current).first_column = YYRHSLOC (Rhs, 1).first_column; \ + (Current).last_line = YYRHSLOC (Rhs, N).last_line; \ + (Current).last_column = YYRHSLOC (Rhs, N).last_column; \ + } \ + else \ + { \ + (Current).first_line = (Current).last_line = \ + YYRHSLOC (Rhs, 0).last_line; \ + (Current).first_column = (Current).last_column = \ + YYRHSLOC (Rhs, 0).last_column; \ + } \ + while (YYID (0)) +#endif + + +/* YY_LOCATION_PRINT -- Print the location on the stream. + This macro was not mandated originally: define only if we know + we won't break user code: when these are the locations we know. */ + +#ifndef YY_LOCATION_PRINT +# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL +# define YY_LOCATION_PRINT(File, Loc) \ + fprintf (File, "%d.%d-%d.%d", \ + (Loc).first_line, (Loc).first_column, \ + (Loc).last_line, (Loc).last_column) +# else +# define YY_LOCATION_PRINT(File, Loc) ((void) 0) +# endif +#endif + + +/* YYLEX -- calling `yylex' with the right arguments. */ + +#ifdef YYLEX_PARAM +# define YYLEX yylex (YYLEX_PARAM) +#else +# define YYLEX yylex () +#endif + +/* Enable debugging if requested. */ +#if YYDEBUG + +# ifndef YYFPRINTF +# include /* INFRINGES ON USER NAME SPACE */ +# define YYFPRINTF fprintf +# endif + +# define YYDPRINTF(Args) \ +do { \ + if (yydebug) \ + YYFPRINTF Args; \ +} while (YYID (0)) + +# define YY_SYMBOL_PRINT(Title, Type, Value, Location) \ +do { \ + if (yydebug) \ + { \ + YYFPRINTF (stderr, "%s ", Title); \ + yy_symbol_print (stderr, \ + Type, Value); \ + YYFPRINTF (stderr, "\n"); \ + } \ +} while (YYID (0)) + + +/*--------------------------------. +| Print this symbol on YYOUTPUT. | +`--------------------------------*/ + +/*ARGSUSED*/ +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static void +yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep) +#else +static void +yy_symbol_value_print (yyoutput, yytype, yyvaluep) + FILE *yyoutput; + int yytype; + YYSTYPE const * const yyvaluep; +#endif +{ + if (!yyvaluep) + return; +# ifdef YYPRINT + if (yytype < YYNTOKENS) + YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep); +# else + YYUSE (yyoutput); +# endif + switch (yytype) + { + default: + break; + } +} + + +/*--------------------------------. +| Print this symbol on YYOUTPUT. | +`--------------------------------*/ + +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static void +yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep) +#else +static void +yy_symbol_print (yyoutput, yytype, yyvaluep) + FILE *yyoutput; + int yytype; + YYSTYPE const * const yyvaluep; +#endif +{ + if (yytype < YYNTOKENS) + YYFPRINTF (yyoutput, "token %s (", yytname[yytype]); + else + YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]); + + yy_symbol_value_print (yyoutput, yytype, yyvaluep); + YYFPRINTF (yyoutput, ")"); +} + +/*------------------------------------------------------------------. +| yy_stack_print -- Print the state stack from its BOTTOM up to its | +| TOP (included). | +`------------------------------------------------------------------*/ + +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static void +yy_stack_print (yytype_int16 *bottom, yytype_int16 *top) +#else +static void +yy_stack_print (bottom, top) + yytype_int16 *bottom; + yytype_int16 *top; +#endif +{ + YYFPRINTF (stderr, "Stack now"); + for (; bottom <= top; ++bottom) + YYFPRINTF (stderr, " %d", *bottom); + YYFPRINTF (stderr, "\n"); +} + +# define YY_STACK_PRINT(Bottom, Top) \ +do { \ + if (yydebug) \ + yy_stack_print ((Bottom), (Top)); \ +} while (YYID (0)) + + +/*------------------------------------------------. +| Report that the YYRULE is going to be reduced. | +`------------------------------------------------*/ + +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static void +yy_reduce_print (YYSTYPE *yyvsp, int yyrule) +#else +static void +yy_reduce_print (yyvsp, yyrule) + YYSTYPE *yyvsp; + int yyrule; +#endif +{ + int yynrhs = yyr2[yyrule]; + int yyi; + unsigned long int yylno = yyrline[yyrule]; + YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n", + yyrule - 1, yylno); + /* The symbols being reduced. */ + for (yyi = 0; yyi < yynrhs; yyi++) + { + fprintf (stderr, " $%d = ", yyi + 1); + yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi], + &(yyvsp[(yyi + 1) - (yynrhs)]) + ); + fprintf (stderr, "\n"); + } +} + +# define YY_REDUCE_PRINT(Rule) \ +do { \ + if (yydebug) \ + yy_reduce_print (yyvsp, Rule); \ +} while (YYID (0)) + +/* Nonzero means print parse trace. It is left uninitialized so that + multiple parsers can coexist. */ +int yydebug; +#else /* !YYDEBUG */ +# define YYDPRINTF(Args) +# define YY_SYMBOL_PRINT(Title, Type, Value, Location) +# define YY_STACK_PRINT(Bottom, Top) +# define YY_REDUCE_PRINT(Rule) +#endif /* !YYDEBUG */ + + +/* YYINITDEPTH -- initial size of the parser's stacks. */ +#ifndef YYINITDEPTH +# define YYINITDEPTH 200 +#endif + +/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only + if the built-in stack extension method is used). + + Do not make this value too large; the results are undefined if + YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH) + evaluated with infinite-precision integer arithmetic. */ + +#ifndef YYMAXDEPTH +# define YYMAXDEPTH 10000 +#endif + + + +#if YYERROR_VERBOSE + +# ifndef yystrlen +# if defined __GLIBC__ && defined _STRING_H +# define yystrlen strlen +# else +/* Return the length of YYSTR. */ +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static YYSIZE_T +yystrlen (const char *yystr) +#else +static YYSIZE_T +yystrlen (yystr) + const char *yystr; +#endif +{ + YYSIZE_T yylen; + for (yylen = 0; yystr[yylen]; yylen++) + continue; + return yylen; +} +# endif +# endif + +# ifndef yystpcpy +# if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE +# define yystpcpy stpcpy +# else +/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in + YYDEST. */ +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static char * +yystpcpy (char *yydest, const char *yysrc) +#else +static char * +yystpcpy (yydest, yysrc) + char *yydest; + const char *yysrc; +#endif +{ + char *yyd = yydest; + const char *yys = yysrc; + + while ((*yyd++ = *yys++) != '\0') + continue; + + return yyd - 1; +} +# endif +# endif + +# ifndef yytnamerr +/* Copy to YYRES the contents of YYSTR after stripping away unnecessary + quotes and backslashes, so that it's suitable for yyerror. The + heuristic is that double-quoting is unnecessary unless the string + contains an apostrophe, a comma, or backslash (other than + backslash-backslash). YYSTR is taken from yytname. If YYRES is + null, do not copy; instead, return the length of what the result + would have been. */ +static YYSIZE_T +yytnamerr (char *yyres, const char *yystr) +{ + if (*yystr == '"') + { + YYSIZE_T yyn = 0; + char const *yyp = yystr; + + for (;;) + switch (*++yyp) + { + case '\'': + case ',': + goto do_not_strip_quotes; + + case '\\': + if (*++yyp != '\\') + goto do_not_strip_quotes; + /* Fall through. */ + default: + if (yyres) + yyres[yyn] = *yyp; + yyn++; + break; + + case '"': + if (yyres) + yyres[yyn] = '\0'; + return yyn; + } + do_not_strip_quotes: ; + } + + if (! yyres) + return yystrlen (yystr); + + return yystpcpy (yyres, yystr) - yyres; +} +# endif + +/* Copy into YYRESULT an error message about the unexpected token + YYCHAR while in state YYSTATE. Return the number of bytes copied, + including the terminating null byte. If YYRESULT is null, do not + copy anything; just return the number of bytes that would be + copied. As a special case, return 0 if an ordinary "syntax error" + message will do. Return YYSIZE_MAXIMUM if overflow occurs during + size calculation. */ +static YYSIZE_T +yysyntax_error (char *yyresult, int yystate, int yychar) +{ + int yyn = yypact[yystate]; + + if (! (YYPACT_NINF < yyn && yyn <= YYLAST)) + return 0; + else + { + int yytype = YYTRANSLATE (yychar); + YYSIZE_T yysize0 = yytnamerr (0, yytname[yytype]); + YYSIZE_T yysize = yysize0; + YYSIZE_T yysize1; + int yysize_overflow = 0; + enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 }; + char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM]; + int yyx; + +# if 0 + /* This is so xgettext sees the translatable formats that are + constructed on the fly. */ + YY_("syntax error, unexpected %s"); + YY_("syntax error, unexpected %s, expecting %s"); + YY_("syntax error, unexpected %s, expecting %s or %s"); + YY_("syntax error, unexpected %s, expecting %s or %s or %s"); + YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s"); +# endif + char *yyfmt; + char const *yyf; + static char const yyunexpected[] = "syntax error, unexpected %s"; + static char const yyexpecting[] = ", expecting %s"; + static char const yyor[] = " or %s"; + char yyformat[sizeof yyunexpected + + sizeof yyexpecting - 1 + + ((YYERROR_VERBOSE_ARGS_MAXIMUM - 2) + * (sizeof yyor - 1))]; + char const *yyprefix = yyexpecting; + + /* Start YYX at -YYN if negative to avoid negative indexes in + YYCHECK. */ + int yyxbegin = yyn < 0 ? -yyn : 0; + + /* Stay within bounds of both yycheck and yytname. */ + int yychecklim = YYLAST - yyn + 1; + int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS; + int yycount = 1; + + yyarg[0] = yytname[yytype]; + yyfmt = yystpcpy (yyformat, yyunexpected); + + for (yyx = yyxbegin; yyx < yyxend; ++yyx) + if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR) + { + if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM) + { + yycount = 1; + yysize = yysize0; + yyformat[sizeof yyunexpected - 1] = '\0'; + break; + } + yyarg[yycount++] = yytname[yyx]; + yysize1 = yysize + yytnamerr (0, yytname[yyx]); + yysize_overflow |= (yysize1 < yysize); + yysize = yysize1; + yyfmt = yystpcpy (yyfmt, yyprefix); + yyprefix = yyor; + } + + yyf = YY_(yyformat); + yysize1 = yysize + yystrlen (yyf); + yysize_overflow |= (yysize1 < yysize); + yysize = yysize1; + + if (yysize_overflow) + return YYSIZE_MAXIMUM; + + if (yyresult) + { + /* Avoid sprintf, as that infringes on the user's name space. + Don't have undefined behavior even if the translation + produced a string with the wrong number of "%s"s. */ + char *yyp = yyresult; + int yyi = 0; + while ((*yyp = *yyf) != '\0') + { + if (*yyp == '%' && yyf[1] == 's' && yyi < yycount) + { + yyp += yytnamerr (yyp, yyarg[yyi++]); + yyf += 2; + } + else + { + yyp++; + yyf++; + } + } + } + return yysize; + } +} +#endif /* YYERROR_VERBOSE */ + + +/*-----------------------------------------------. +| Release the memory associated to this symbol. | +`-----------------------------------------------*/ + +/*ARGSUSED*/ +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static void +yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep) +#else +static void +yydestruct (yymsg, yytype, yyvaluep) + const char *yymsg; + int yytype; + YYSTYPE *yyvaluep; +#endif +{ + YYUSE (yyvaluep); + + if (!yymsg) + yymsg = "Deleting"; + YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp); + + switch (yytype) + { + + default: + break; + } +} + + +/* Prevent warnings from -Wmissing-prototypes. */ + +#ifdef YYPARSE_PARAM +#if defined __STDC__ || defined __cplusplus +int yyparse (void *YYPARSE_PARAM); +#else +int yyparse (); +#endif +#else /* ! YYPARSE_PARAM */ +#if defined __STDC__ || defined __cplusplus +int yyparse (void); +#else +int yyparse (); +#endif +#endif /* ! YYPARSE_PARAM */ + + + +/* The look-ahead symbol. */ +int yychar; + +/* The semantic value of the look-ahead symbol. */ +YYSTYPE yylval; + +/* Number of syntax errors so far. */ +int yynerrs; + + + +/*----------. +| yyparse. | +`----------*/ + +#ifdef YYPARSE_PARAM +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +int +yyparse (void *YYPARSE_PARAM) +#else +int +yyparse (YYPARSE_PARAM) + void *YYPARSE_PARAM; +#endif +#else /* ! YYPARSE_PARAM */ +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +int +yyparse (void) +#else +int +yyparse () + +#endif +#endif +{ + + int yystate; + int yyn; + int yyresult; + /* Number of tokens to shift before error messages enabled. */ + int yyerrstatus; + /* Look-ahead token as an internal (translated) token number. */ + int yytoken = 0; +#if YYERROR_VERBOSE + /* Buffer for error messages, and its allocated size. */ + char yymsgbuf[128]; + char *yymsg = yymsgbuf; + YYSIZE_T yymsg_alloc = sizeof yymsgbuf; +#endif + + /* Three stacks and their tools: + `yyss': related to states, + `yyvs': related to semantic values, + `yyls': related to locations. + + Refer to the stacks thru separate pointers, to allow yyoverflow + to reallocate them elsewhere. */ + + /* The state stack. */ + yytype_int16 yyssa[YYINITDEPTH]; + yytype_int16 *yyss = yyssa; + yytype_int16 *yyssp; + + /* The semantic value stack. */ + YYSTYPE yyvsa[YYINITDEPTH]; + YYSTYPE *yyvs = yyvsa; + YYSTYPE *yyvsp; + + + +#define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N)) + + YYSIZE_T yystacksize = YYINITDEPTH; + + /* The variables used to return semantic value and location from the + action routines. */ + YYSTYPE yyval; + + + /* The number of symbols on the RHS of the reduced rule. + Keep to zero when no symbol should be popped. */ + int yylen = 0; + + YYDPRINTF ((stderr, "Starting parse\n")); + + yystate = 0; + yyerrstatus = 0; + yynerrs = 0; + yychar = YYEMPTY; /* Cause a token to be read. */ + + /* Initialize stack pointers. + Waste one element of value and location stack + so that they stay on the same level as the state stack. + The wasted elements are never initialized. */ + + yyssp = yyss; + yyvsp = yyvs; + + goto yysetstate; + +/*------------------------------------------------------------. +| yynewstate -- Push a new state, which is found in yystate. | +`------------------------------------------------------------*/ + yynewstate: + /* In all cases, when you get here, the value and location stacks + have just been pushed. So pushing a state here evens the stacks. */ + yyssp++; + + yysetstate: + *yyssp = yystate; + + if (yyss + yystacksize - 1 <= yyssp) + { + /* Get the current used size of the three stacks, in elements. */ + YYSIZE_T yysize = yyssp - yyss + 1; + +#ifdef yyoverflow + { + /* Give user a chance to reallocate the stack. Use copies of + these so that the &'s don't force the real ones into + memory. */ + YYSTYPE *yyvs1 = yyvs; + yytype_int16 *yyss1 = yyss; + + + /* Each stack pointer address is followed by the size of the + data in use in that stack, in bytes. This used to be a + conditional around just the two extra args, but that might + be undefined if yyoverflow is a macro. */ + yyoverflow (YY_("memory exhausted"), + &yyss1, yysize * sizeof (*yyssp), + &yyvs1, yysize * sizeof (*yyvsp), + + &yystacksize); + + yyss = yyss1; + yyvs = yyvs1; + } +#else /* no yyoverflow */ +# ifndef YYSTACK_RELOCATE + goto yyexhaustedlab; +# else + /* Extend the stack our own way. */ + if (YYMAXDEPTH <= yystacksize) + goto yyexhaustedlab; + yystacksize *= 2; + if (YYMAXDEPTH < yystacksize) + yystacksize = YYMAXDEPTH; + + { + yytype_int16 *yyss1 = yyss; + union yyalloc *yyptr = + (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize)); + if (! yyptr) + goto yyexhaustedlab; + YYSTACK_RELOCATE (yyss); + YYSTACK_RELOCATE (yyvs); + +# undef YYSTACK_RELOCATE + if (yyss1 != yyssa) + YYSTACK_FREE (yyss1); + } +# endif +#endif /* no yyoverflow */ + + yyssp = yyss + yysize - 1; + yyvsp = yyvs + yysize - 1; + + + YYDPRINTF ((stderr, "Stack size increased to %lu\n", + (unsigned long int) yystacksize)); + + if (yyss + yystacksize - 1 <= yyssp) + YYABORT; + } + + YYDPRINTF ((stderr, "Entering state %d\n", yystate)); + + goto yybackup; + +/*-----------. +| yybackup. | +`-----------*/ +yybackup: + + /* Do appropriate processing given the current state. Read a + look-ahead token if we need one and don't already have one. */ + + /* First try to decide what to do without reference to look-ahead token. */ + yyn = yypact[yystate]; + if (yyn == YYPACT_NINF) + goto yydefault; + + /* Not known => get a look-ahead token if don't already have one. */ + + /* YYCHAR is either YYEMPTY or YYEOF or a valid look-ahead symbol. */ + if (yychar == YYEMPTY) + { + YYDPRINTF ((stderr, "Reading a token: ")); + yychar = YYLEX; + } + + if (yychar <= YYEOF) + { + yychar = yytoken = YYEOF; + YYDPRINTF ((stderr, "Now at end of input.\n")); + } + else + { + yytoken = YYTRANSLATE (yychar); + YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc); + } + + /* If the proper action on seeing token YYTOKEN is to reduce or to + detect an error, take that action. */ + yyn += yytoken; + if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken) + goto yydefault; + yyn = yytable[yyn]; + if (yyn <= 0) + { + if (yyn == 0 || yyn == YYTABLE_NINF) + goto yyerrlab; + yyn = -yyn; + goto yyreduce; + } + + if (yyn == YYFINAL) + YYACCEPT; + + /* Count tokens shifted since error; after three, turn off error + status. */ + if (yyerrstatus) + yyerrstatus--; + + /* Shift the look-ahead token. */ + YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc); + + /* Discard the shifted token unless it is eof. */ + if (yychar != YYEOF) + yychar = YYEMPTY; + + yystate = yyn; + *++yyvsp = yylval; + + goto yynewstate; + + +/*-----------------------------------------------------------. +| yydefault -- do the default action for the current state. | +`-----------------------------------------------------------*/ +yydefault: + yyn = yydefact[yystate]; + if (yyn == 0) + goto yyerrlab; + goto yyreduce; + + +/*-----------------------------. +| yyreduce -- Do a reduction. | +`-----------------------------*/ +yyreduce: + /* yyn is the number of a rule to reduce with. */ + yylen = yyr2[yyn]; + + /* If YYLEN is nonzero, implement the default value of the action: + `$$ = $1'. + + Otherwise, the following line sets YYVAL to garbage. + This behavior is undocumented and Bison + users should not rely upon it. Assigning to YYVAL + unconditionally makes the parser a bit smaller, and it avoids a + GCC warning that YYVAL may be used uninitialized. */ + yyval = yyvsp[1-yylen]; + + + YY_REDUCE_PRINT (yyn); + switch (yyn) + { + case 2: +#line 116 "kc.y" + { + SetupTableMan(); + } + break; + + case 3: +#line 120 "kc.y" + { + if (verbose==1) { /* Printing status report */ + printf("Species used (*=dyn. var.):\n"); + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + if (IsSpecInConstraint(name, charge)==0) + printf(" *%s(", name); + else + printf(" %s(", name); + if (charge==FLT_MAX) + printf("."); + else { + if (charge>0.0) + printf("%d+", (int)charge); + else if (charge<0.0) + printf("%d-", -(int)charge); + } /* else */ + printf(")\n"); + } /* for i*/ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + printf(" *%s\n", name); + } /* for i */ + if (NumOfParameter()!=0) { + printf("Parameters declared:\n"); + for(i=1; i<=NumOfParameter(); i++) { + GetParamNo(i, name, &charge, &side); /* abuse of side */ + if (charge==0.0) + printf(" %s\n", name); + else { + if (side==1) + printf(" %s\n", name); + else { + printf(" %s(", name); + if (charge==FLT_MAX) + printf("."); + else { + if (charge>0.0) + printf("%d+", (int)charge); + else if (charge<0.0) + printf("%d-", -(int)charge); + } /* else */ + printf(")\n"); + } /* else */ + } /* else */ + } /* for i */ + } /* if */ + printf("Constants declared:\n"); + for(i=1; i<=NumOfConstants(); i++) { + GetConstantNo(i, name); + printf(" %s = %e\n", name, GetConstant(name)); + } /* for i */ + for(i=1; i<=NumOfStrConst(); i++) { + GetStrConstNo(i, name, string); + printf(" %s = \"%s\"\n", name, string); + } /* for i */ + } /* if */ + if (IsNonAutoSystem()==1) { + NewDynVar("time"); + tmp=TreeCreate(); + TreeAssignConst(tmp, 1.0); + NewExpr("time", tmp); + TreeKill(tmp); + } /* if */ + } + break; + + case 9: +#line 191 "kc.y" + { if ((yyvsp[(3) - (3)].strnum).flag==1) + NewConstant((yyvsp[(1) - (3)].name), (yyvsp[(3) - (3)].strnum).numb); + else { + NewStrConst((yyvsp[(1) - (3)].name), (yyvsp[(3) - (3)].strnum).name); + } + } + break; + + case 10: +#line 198 "kc.y" + { temp=TreeEval((yyvsp[(1) - (2)].tree)); + if (TreeGetError()==NoEval) + fprintf(stderr, "Unable to evaluate expression in line %d.\n", lineno); + else { + (yyval.strnum).flag=1; + (yyval.strnum).numb=temp; + } + TreeKill((yyvsp[(1) - (2)].tree)); + } + break; + + case 11: +#line 208 "kc.y" + { (yyval.strnum).flag=2; + strcpy((yyval.strnum).name, (yyvsp[(2) - (4)].name)); + } + break; + + case 14: +#line 214 "kc.y" + { NewPrintVar((yyvsp[(1) - (1)].name)); } + break; + + case 15: +#line 216 "kc.y" + { NewPrintConc((yyvsp[(1) - (1)].comp).name, (yyvsp[(1) - (1)].comp).charge); } + break; + + case 17: +#line 219 "kc.y" + { temp=TreeEval((yyvsp[(3) - (13)].tree)); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n", lineno); + else { + NewParameter((yyvsp[(1) - (13)].name), temp); + } + TreeKill((yyvsp[(3) - (13)].tree)); + temp=TreeEval((yyvsp[(5) - (13)].tree)); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n", lineno); + else + NewDeltaParam((yyvsp[(1) - (13)].name), temp); + TreeKill((yyvsp[(5) - (13)].tree)); + temp1=TreeEval((yyvsp[(7) - (13)].tree)); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n" , lineno); + TreeKill((yyvsp[(7) - (13)].tree)); + temp2=TreeEval((yyvsp[(11) - (13)].tree)); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n" , lineno); + TreeKill((yyvsp[(11) - (13)].tree)); + NewLowHighPrefParam((yyvsp[(1) - (13)].name), temp, temp1, temp2); + temp=TreeEval((yyvsp[(13) - (13)].tree)); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n", lineno); + TreeKill((yyvsp[(13) - (13)].tree)); + NewDirectForParam((yyvsp[(1) - (13)].name), (int)temp); + temp=TreeEval((yyvsp[(9) - (13)].tree)); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n", lineno); + TreeKill((yyvsp[(9) - (13)].tree)); + NewDeltaParam((yyvsp[(1) - (13)].name), temp); + } + break; + + case 18: +#line 253 "kc.y" + { temp=TreeEval((yyvsp[(3) - (13)].tree)); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %\n", lineno); + else + NewParamConc((yyvsp[(1) - (13)].comp).name, (yyvsp[(1) - (13)].comp).charge, temp); + temp=TreeEval((yyvsp[(5) - (13)].tree)); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %\n", lineno); + TreeKill((yyvsp[(3) - (13)].tree)); + TreeKill((yyvsp[(5) - (13)].tree)); + temp1=TreeEval((yyvsp[(7) - (13)].tree)); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n" , lineno); + TreeKill((yyvsp[(7) - (13)].tree)); + temp2=TreeEval((yyvsp[(11) - (13)].tree)); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n" , lineno); + TreeKill((yyvsp[(11) - (13)].tree)); + NewLowHighPrefConc((yyvsp[(1) - (13)].comp).name, (yyvsp[(1) - (13)].comp).charge, temp, temp1, temp2); + temp=TreeEval((yyvsp[(13) - (13)].tree)); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n", lineno); + TreeKill((yyvsp[(9) - (13)].tree)); + NewDirectForConc((yyvsp[(1) - (13)].comp).name, (yyvsp[(1) - (13)].comp).charge, (int)temp); + temp=TreeEval((yyvsp[(9) - (13)].tree)); + if (TreeGetError()==NoEval) + fprintf(stderr, "WARNING: Could not evaluate expr in line %d\n", lineno); + TreeKill((yyvsp[(9) - (13)].tree)); + NewDeltaConc((yyvsp[(1) - (13)].comp).name, (yyvsp[(1) - (13)].comp).charge, temp); + } + break; + + case 21: +#line 286 "kc.y" + { NewReaction((int)value); + side=1; + } + break; + + case 22: +#line 290 "kc.y" + { + switch ((yyvsp[(5) - (5)].flag)) { + case '>': + AddReactionKind(GetCurrentReaction(), uni); + break; + case '<': + AddReactionKind(GetCurrentReaction(), bi); + break; + case '=': + AddReactionKind(GetCurrentReaction(), equi); + break; + }; /* switch */ + side=-1; + } + break; + + case 24: +#line 306 "kc.y" + { NewExpr((yyvsp[(1) - (5)].name), (yyvsp[(4) - (5)].tree)); + NewDynVar((yyvsp[(1) - (5)].name)); + TreeKill((yyvsp[(4) - (5)].tree)); + } + break; + + case 29: +#line 315 "kc.y" + { if (strcmp((yyvsp[(1) - (6)].name), "c")!=0) + fprintf(stderr, "c expected!\n"); + else { + temp=TreeEval((yyvsp[(6) - (6)].tree)); + if (TreeGetError()==NoEval) + fprintf(stderr, "Unable to evaluate expression in line %d.\n", lineno); + else + NewPowerConst(GetCurrentReaction(), (yyvsp[(3) - (6)].comp).name, (yyvsp[(3) - (6)].comp).charge, temp, side); + }; /* else */ + TreeKill((yyvsp[(6) - (6)].tree)); + } + break; + + case 30: +#line 327 "kc.y" + { if (strcmp((yyvsp[(1) - (3)].name), "k")==0) { + NewRateConst(GetCurrentReaction(), -1, (yyvsp[(3) - (3)].tree)); + } /* if */ + else + if (strcmp((yyvsp[(1) - (3)].name), "v")==0) + NewRateExpr(GetCurrentReaction(), -1, (yyvsp[(3) - (3)].tree)); + else + fprintf(stderr, "Syntax error: v or k expected in line %d.\n", lineno); + TreeKill((yyvsp[(3) - (3)].tree)); + } + break; + + case 32: +#line 339 "kc.y" + { if (strcmp((yyvsp[(1) - (3)].name), "K")!=0) + fprintf(stderr, "Syntax error: K expected in line %d.\n", lineno); + else { + NewRateConst(GetCurrentReaction(), 0, (yyvsp[(3) - (3)].tree)); + }; /* else */ + TreeKill((yyvsp[(3) - (3)].tree)); + } + break; + + case 33: +#line 346 "kc.y" + { if (GetReactKind(GetCurrentReaction())==bi) (void) fprintf(stderr, "The reaction in line %d is two-ways.\n", lineno); + } + break; + + case 34: +#line 349 "kc.y" + { if (GetReactKind(GetCurrentReaction())!=bi) + (void) fprintf(stderr, "The reaction in line %d is a >one-way< reaction or >equilibrium.<\n", lineno); + else { + if (strcmp((yyvsp[(1) - (4)].name), "k")==0) + NewRateConst(GetCurrentReaction(), 1, (yyvsp[(3) - (4)].tree)); + else + if (strcmp((yyvsp[(1) - (4)].name), "v")==0) + NewRateExpr(GetCurrentReaction(), 1, (yyvsp[(3) - (4)].tree)); + else + fprintf(stderr, "Syntax error: v or k expected in line %d.\n", lineno); + }; /* else */ + TreeKill((yyvsp[(3) - (4)].tree)); + } + break; + + case 35: +#line 362 "kc.y" + { (yyval.flag)='>'; } + break; + + case 36: +#line 363 "kc.y" + { (yyval.flag)='<'; } + break; + + case 37: +#line 364 "kc.y" + { (yyval.flag)='='; } + break; + + case 38: +#line 366 "kc.y" + { SpecieInReaction(GetCurrentReaction(), (yyvsp[(2) - (2)].comp).name, (yyvsp[(2) - (2)].comp).charge); + NewCoeff(GetCurrentReaction(), (yyvsp[(2) - (2)].comp).name, (yyvsp[(2) - (2)].comp).charge, (yyvsp[(1) - (2)].dval), side); + NewSpecie((yyvsp[(2) - (2)].comp).name, (yyvsp[(2) - (2)].comp).charge); + } + break; + + case 39: +#line 371 "kc.y" + { SpecieInReaction(GetCurrentReaction(), (yyvsp[(4) - (4)].comp).name, (yyvsp[(4) - (4)].comp).charge); + NewCoeff(GetCurrentReaction(), (yyvsp[(4) - (4)].comp).name, (yyvsp[(4) - (4)].comp).charge, (yyvsp[(3) - (4)].dval), side); + NewSpecie((yyvsp[(4) - (4)].comp).name, (yyvsp[(4) - (4)].comp).charge); + } + break; + + case 40: +#line 376 "kc.y" + { + (void) strcpy((yyval.comp).name, (yyvsp[(1) - (2)].name)); + (yyval.comp).charge=(yyvsp[(2) - (2)].dval); + (yyval.comp).concs=no; + } + break; + + case 41: +#line 382 "kc.y" + { (yyval.dval)=(yyvsp[(2) - (3)].dval); } + break; + + case 42: +#line 383 "kc.y" + { + (yyval.dval)=0.0; + } + break; + + case 43: +#line 387 "kc.y" + { charge=FLT_MAX; + (yyval.dval)=FLT_MAX; + } + break; + + case 44: +#line 391 "kc.y" + { if ((yyvsp[(1) - (2)].oper)=='+') { + (yyval.dval)=(yyvsp[(2) - (2)].dval); + charge=(yyvsp[(2) - (2)].dval); + } /* if */ + else { + charge=-(yyvsp[(2) - (2)].dval); + (yyval.dval)=-(yyvsp[(2) - (2)].dval); + }; /* else */ + } + break; + + case 45: +#line 401 "kc.y" + { if ((yyvsp[(1) - (1)].oper)=='+') + (yyval.dval)=1.0; + else + (yyval.dval)=-1.0; + } + break; + + case 46: +#line 406 "kc.y" + { (yyval.oper) = '+'; } + break; + + case 47: +#line 407 "kc.y" + { (yyval.oper) = '-'; } + break; + + case 48: +#line 409 "kc.y" + { coeff=value; + (yyval.dval)=(yyvsp[(1) - (1)].dval); + } + break; + + case 49: +#line 413 "kc.y" + { coeff=1.0; + (yyval.dval)=1.0; + } + break; + + case 52: +#line 419 "kc.y" + { temp=TreeEval((yyvsp[(4) - (5)].tree)); + switch ((yyvsp[(2) - (5)].flag)) { + case 1: + if (TreeGetError()==NoEval) + fprintf(stderr, "Unable to evaluate expression.\n"); + else + NewBeginConc((yyvsp[(1) - (5)].comp).name, (yyvsp[(1) - (5)].comp).charge, temp); + break; + case 0: + NewConstraint((yyvsp[(1) - (5)].comp).name, (yyvsp[(1) - (5)].comp).charge, (yyvsp[(4) - (5)].tree)); + break; + }; + TreeKill((yyvsp[(4) - (5)].tree)); + } + break; + + case 53: +#line 434 "kc.y" + { temp=TreeEval((yyvsp[(6) - (7)].tree)); + NewSpecConst((yyvsp[(3) - (7)].comp).name, (yyvsp[(3) - (7)].comp).charge, (yyvsp[(1) - (7)].name), temp); + if (GetError()==NotFound) + if ((yyvsp[(3) - (7)].comp).charge==0.0) + NewDynVarConst((yyvsp[(3) - (7)].comp).name, (yyvsp[(1) - (7)].name), temp); + TreeKill((yyvsp[(6) - (7)].tree)); + } + break; + + case 54: +#line 442 "kc.y" + { temp=TreeEval((yyvsp[(4) - (5)].tree)); + if (TreeGetError()==NoEval) + yyerror("Unable to evaluate expression"); + else { + if ((yyvsp[(2) - (5)].flag)==1) { + NewInitValue((yyvsp[(1) - (5)].name), temp); + TreeKill((yyvsp[(4) - (5)].tree)); + } else + yyerror("(0) expected"); + } + } + break; + + case 55: +#line 454 "kc.y" + { (yyval.tree)=TreeCreate(); + TreeCpy((yyval.tree), (yyvsp[(2) - (2)].tree)); + TreeSign((yyval.tree)); + TreeKill((yyvsp[(2) - (2)].tree)); + } + break; + + case 56: +#line 460 "kc.y" + { (yyval.tree)=TreeCreate(); + TreeAdd((yyvsp[(1) - (3)].tree), (yyvsp[(3) - (3)].tree)); + TreeCpy((yyval.tree), (yyvsp[(1) - (3)].tree)); + TreeKill((yyvsp[(3) - (3)].tree)); + TreeKill((yyvsp[(1) - (3)].tree)); + } + break; + + case 57: +#line 467 "kc.y" + { (yyval.tree)=TreeCreate(); + TreeSub((yyvsp[(1) - (3)].tree), (yyvsp[(3) - (3)].tree)); + TreeCpy((yyval.tree), (yyvsp[(1) - (3)].tree)); + TreeKill((yyvsp[(3) - (3)].tree)); + TreeKill((yyvsp[(1) - (3)].tree)); + } + break; + + case 58: +#line 474 "kc.y" + { + (yyval.tree)=TreeCreate(); + TreeMul((yyvsp[(1) - (3)].tree), (yyvsp[(3) - (3)].tree)); + TreeCpy((yyval.tree), (yyvsp[(1) - (3)].tree)); + TreeKill((yyvsp[(1) - (3)].tree)); + TreeKill((yyvsp[(3) - (3)].tree)); + } + break; + + case 59: +#line 482 "kc.y" + { + (yyval.tree)=TreeCreate(); + TreeDiv((yyvsp[(1) - (3)].tree), (yyvsp[(3) - (3)].tree)); + TreeCpy((yyval.tree), (yyvsp[(1) - (3)].tree)); + TreeKill((yyvsp[(1) - (3)].tree)); + TreeKill((yyvsp[(3) - (3)].tree)); + } + break; + + case 60: +#line 490 "kc.y" + { (yyval.tree)=TreeCreate(); + TreeCpy((yyval.tree), (yyvsp[(1) - (3)].tree)); + TreePow((yyval.tree), (yyvsp[(3) - (3)].tree)); + TreeKill((yyvsp[(1) - (3)].tree)); + TreeKill((yyvsp[(3) - (3)].tree)); + } + break; + + case 61: +#line 497 "kc.y" + { (yyval.tree)=TreeCreate(); + TreeCpy((yyval.tree), (yyvsp[(2) - (3)].tree)); + TreeKill((yyvsp[(2) - (3)].tree)); + } + break; + + case 62: +#line 502 "kc.y" + { + (yyval.tree)=TreeCreate(); + temp=GetConstant((yyvsp[(1) - (1)].name)); + if (GetError()==NotFound) { + TreeAssignVar((yyval.tree), (yyvsp[(1) - (1)].name)); + if (strcmp((yyvsp[(1) - (1)].name), "time")==0) + NonAutoSystem(); + } else + TreeAssignConst((yyval.tree), temp); + } + break; + + case 63: +#line 513 "kc.y" + { (yyval.tree)=TreeCreate(); + TreeAssignConst((yyval.tree), (yyvsp[(1) - (1)].dval)); + } + break; + + case 64: +#line 517 "kc.y" + { + (yyval.tree)=TreeCreate(); + if ((yyvsp[(2) - (2)].flag)==1) { + temp=GetBeginConc((yyvsp[(1) - (2)].comp).name, (yyvsp[(1) - (2)].comp).charge); + if (GetError()==NoError) + TreeAssignConst((yyval.tree), temp); + else + fprintf(stderr, "[%s(%e)] not found.\n", (yyvsp[(1) - (2)].comp).name, (yyvsp[(1) - (2)].comp).charge); + flag='1'; + } /* if */ + else { + flag='0'; + RenameSpec(name, (yyvsp[(1) - (2)].comp).name, (yyvsp[(1) - (2)].comp).charge); + TreeAssignVar((yyval.tree), name); + }; /* else */ + } + break; + + case 65: +#line 534 "kc.y" + { (yyval.tree)=TreeCreate(); + TreeCpy((yyval.tree), (yyvsp[(3) - (4)].tree)); + TreeApplyFunc(&(yyval.tree), (yyvsp[(1) - (4)].func)); + TreeKill((yyvsp[(3) - (4)].tree)); + } + break; + + case 66: +#line 539 "kc.y" + { (yyval.func)=Exp; } + break; + + case 67: +#line 540 "kc.y" + { (yyval.func)=Ln; } + break; + + case 68: +#line 541 "kc.y" + { (yyval.func)=Log; } + break; + + case 69: +#line 542 "kc.y" + { (yyval.func)=Sin; } + break; + + case 70: +#line 543 "kc.y" + { (yyval.func)=Cos; } + break; + + case 71: +#line 544 "kc.y" + { (yyval.func)=Tan; } + break; + + case 72: +#line 545 "kc.y" + { (yyval.func)=Sinh; } + break; + + case 73: +#line 546 "kc.y" + { (yyval.func)=Cosh; } + break; + + case 74: +#line 547 "kc.y" + { (yyval.func)=Tanh; } + break; + + case 75: +#line 548 "kc.y" + { (yyval.func)=Asin; } + break; + + case 76: +#line 549 "kc.y" + { (yyval.func)=Acos; } + break; + + case 77: +#line 550 "kc.y" + { (yyval.func)=Atan; } + break; + + case 78: +#line 551 "kc.y" + { (yyval.func)=Asinh; } + break; + + case 79: +#line 552 "kc.y" + { (yyval.func)=Acosh; } + break; + + case 80: +#line 553 "kc.y" + { (yyval.func)=Atanh; } + break; + + case 81: +#line 555 "kc.y" + { + (void) strcpy((yyval.comp).name, (yyvsp[(2) - (3)].comp).name); + (yyval.comp).charge=(yyvsp[(2) - (3)].comp).charge; + (yyval.comp).concs=ord; + } + break; + + case 82: +#line 560 "kc.y" + { (yyval.flag)=0; } + break; + + case 83: +#line 562 "kc.y" + { (yyval.flag)=1; } + break; + + +/* Line 1267 of yacc.c. */ +#line 2282 "y.tab.c" + default: break; + } + YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc); + + YYPOPSTACK (yylen); + yylen = 0; + YY_STACK_PRINT (yyss, yyssp); + + *++yyvsp = yyval; + + + /* Now `shift' the result of the reduction. Determine what state + that goes to, based on the state we popped back to and the rule + number reduced by. */ + + yyn = yyr1[yyn]; + + yystate = yypgoto[yyn - YYNTOKENS] + *yyssp; + if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp) + yystate = yytable[yystate]; + else + yystate = yydefgoto[yyn - YYNTOKENS]; + + goto yynewstate; + + +/*------------------------------------. +| yyerrlab -- here on detecting error | +`------------------------------------*/ +yyerrlab: + /* If not already recovering from an error, report this error. */ + if (!yyerrstatus) + { + ++yynerrs; +#if ! YYERROR_VERBOSE + yyerror (YY_("syntax error")); +#else + { + YYSIZE_T yysize = yysyntax_error (0, yystate, yychar); + if (yymsg_alloc < yysize && yymsg_alloc < YYSTACK_ALLOC_MAXIMUM) + { + YYSIZE_T yyalloc = 2 * yysize; + if (! (yysize <= yyalloc && yyalloc <= YYSTACK_ALLOC_MAXIMUM)) + yyalloc = YYSTACK_ALLOC_MAXIMUM; + if (yymsg != yymsgbuf) + YYSTACK_FREE (yymsg); + yymsg = (char *) YYSTACK_ALLOC (yyalloc); + if (yymsg) + yymsg_alloc = yyalloc; + else + { + yymsg = yymsgbuf; + yymsg_alloc = sizeof yymsgbuf; + } + } + + if (0 < yysize && yysize <= yymsg_alloc) + { + (void) yysyntax_error (yymsg, yystate, yychar); + yyerror (yymsg); + } + else + { + yyerror (YY_("syntax error")); + if (yysize != 0) + goto yyexhaustedlab; + } + } +#endif + } + + + + if (yyerrstatus == 3) + { + /* If just tried and failed to reuse look-ahead token after an + error, discard it. */ + + if (yychar <= YYEOF) + { + /* Return failure if at end of input. */ + if (yychar == YYEOF) + YYABORT; + } + else + { + yydestruct ("Error: discarding", + yytoken, &yylval); + yychar = YYEMPTY; + } + } + + /* Else will try to reuse look-ahead token after shifting the error + token. */ + goto yyerrlab1; + + +/*---------------------------------------------------. +| yyerrorlab -- error raised explicitly by YYERROR. | +`---------------------------------------------------*/ +yyerrorlab: + + /* Pacify compilers like GCC when the user code never invokes + YYERROR and the label yyerrorlab therefore never appears in user + code. */ + if (/*CONSTCOND*/ 0) + goto yyerrorlab; + + /* Do not reclaim the symbols of the rule which action triggered + this YYERROR. */ + YYPOPSTACK (yylen); + yylen = 0; + YY_STACK_PRINT (yyss, yyssp); + yystate = *yyssp; + goto yyerrlab1; + + +/*-------------------------------------------------------------. +| yyerrlab1 -- common code for both syntax error and YYERROR. | +`-------------------------------------------------------------*/ +yyerrlab1: + yyerrstatus = 3; /* Each real token shifted decrements this. */ + + for (;;) + { + yyn = yypact[yystate]; + if (yyn != YYPACT_NINF) + { + yyn += YYTERROR; + if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) + { + yyn = yytable[yyn]; + if (0 < yyn) + break; + } + } + + /* Pop the current state because it cannot handle the error token. */ + if (yyssp == yyss) + YYABORT; + + + yydestruct ("Error: popping", + yystos[yystate], yyvsp); + YYPOPSTACK (1); + yystate = *yyssp; + YY_STACK_PRINT (yyss, yyssp); + } + + if (yyn == YYFINAL) + YYACCEPT; + + *++yyvsp = yylval; + + + /* Shift the error token. */ + YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp); + + yystate = yyn; + goto yynewstate; + + +/*-------------------------------------. +| yyacceptlab -- YYACCEPT comes here. | +`-------------------------------------*/ +yyacceptlab: + yyresult = 0; + goto yyreturn; + +/*-----------------------------------. +| yyabortlab -- YYABORT comes here. | +`-----------------------------------*/ +yyabortlab: + yyresult = 1; + goto yyreturn; + +#ifndef yyoverflow +/*-------------------------------------------------. +| yyexhaustedlab -- memory exhaustion comes here. | +`-------------------------------------------------*/ +yyexhaustedlab: + yyerror (YY_("memory exhausted")); + yyresult = 2; + /* Fall through. */ +#endif + +yyreturn: + if (yychar != YYEOF && yychar != YYEMPTY) + yydestruct ("Cleanup: discarding lookahead", + yytoken, &yylval); + /* Do not reclaim the symbols of the rule which action triggered + this YYABORT or YYACCEPT. */ + YYPOPSTACK (yylen); + YY_STACK_PRINT (yyss, yyssp); + while (yyssp != yyss) + { + yydestruct ("Cleanup: popping", + yystos[*yyssp], yyvsp); + YYPOPSTACK (1); + } +#ifndef yyoverflow + if (yyss != yyssa) + YYSTACK_FREE (yyss); +#endif +#if YYERROR_VERBOSE + if (yymsg != yymsgbuf) + YYSTACK_FREE (yymsg); +#endif + /* Make sure YYID is used. */ + return YYID (yyresult); +} + + +#line 563 "kc.y" + +#include "lex.c" + diff --git a/src/quench.h b/src/quench.h new file mode 100644 index 0000000..f3d9046 --- /dev/null +++ b/src/quench.h @@ -0,0 +1,20 @@ +/***************************************************************************** + Quench is a library for calculation of quenching data. + See quench.h for details. + Last updated: 16 May 1995 by KN +*****************************************************************************/ + +#ifndef _QUENCH_LIB_ +#define _QUENCH_LIB_ + +#include "complex.h" +#include "matrix.h" +#include +#include + +extern double arctan_local(Complex); +extern void compamppha(int, double **, double *, double *); +extern void stopdata(int, int, double **, double *, + double *, double *, double *, double *); + +#endif diff --git a/src/symbmath.c b/src/symbmath.c new file mode 100644 index 0000000..cf2efa5 --- /dev/null +++ b/src/symbmath.c @@ -0,0 +1,1560 @@ +/**************************************************************************** + Implementation of symbolic mathematic. + + (C) Copyright 1992-1996 by + Kenneth Geisshirt (kneth@fatou.ruc.dk) Keld Nielsen (kn@kiku.dk) + Dept. of Life Sciences and Chemistry Dept. of Theoretical Chemistry + Roskilde University University of Copenhagen + P.O. Box 5 Universitetsparken 5 + 4000 Roskilde 2100 Copenhagen East + Denmark Denmark + + See kc.tex for details. + + Last updated: 17 February 1995 +****************************************************************************/ + +#include "config.h" +#include +#include +#include +#include "symbmath.h" +#include "misc.h" + +#ifdef _USE_GARBAGE_COL_ +# include +#else /* use ordinary malloc */ +# include +#endif + +#undef WORKING + +/**************************************************************************** + TreeReduce tries to reduce the complexity of the expression. The routine + is an internal one only, i.e. it is not called by the user explicitely. + + The code is _not_ commented, but at many reductions one can find a short + explaination. The notation is: Expression 1 -> Expression 2. It should be + read as: Expression 1 is reduced to expression 2. The symbols f and g + represents two generic expressions. +*****************************************************************************/ + +void TreeReduce(Tree tin) { + + Tree res, t; + int alter; + + alter=0; + res=TreeCreate(); + t=TreeCreate(); + if (tin!=NULL) { + switch (tin->tag) { + case Oper: + alter=2; + TreeCpy(t, tin); + TreeReduce(t->data.oper.left); + TreeReduce(t->data.oper.right); + switch (t->data.oper.op) { + case Add: + if ((t->data.oper.left->tag==Konst) && + (t->data.oper.right->tag==Konst)) { + alter=1; + res->tag=Konst; + res->data.value=t->data.oper.left->data.value + +t->data.oper.right->data.value; + } /* if */ + if ((t->data.oper.right->tag==Konst) && (alter==2)) { + if (t->data.oper.right->data.value==0.0) { + alter=1; + TreeCpy(res, t->data.oper.left); + } /* if */ + } /* if */ + if ((t->data.oper.left->tag==Konst) && (alter==2)) { + if (t->data.oper.left->data.value==0.0) { + alter=1; + TreeCpy(res, t->data.oper.right); + } /* if */ + } /* if */ + + /* (f+(-g)) -> (f-g) */ + if ((t->data.oper.right->tag==NegSign) && (alter==2)) { + alter=1; + res->tag=Oper; + res->data.oper.op=Sub; + res->data.oper.left=TreeCreate(); + TreeCpy(res->data.oper.left, t->data.oper.left); + res->data.oper.right=TreeCreate(); + TreeCpy(res->data.oper.right, t->data.oper.right); + } /* if */ + break; + case Sub: + if ((t->data.oper.left->tag==Konst) && + (t->data.oper.right->tag==Konst)) { + alter=1; + res->tag=Konst; + res->data.value=t->data.oper.left->data.value + -t->data.oper.right->data.value; + } /* if */ + if ((t->data.oper.right->tag==Konst) && (alter==2)) + if (t->data.oper.right->data.value==0.0) { + alter=1; + TreeCpy(res, t->data.oper.left); + } /* if */ + + if ((t->data.oper.left->tag==Konst) && (alter==2)) { + if (t->data.oper.left->data.value==0.0) { + alter=1; + res->tag=NegSign; + res->data.right=TreeCreate(); + TreeCpy(res->data.right, t->data.oper.right); + } + } /* if */ + if ((t->data.oper.left->tag==Var) && + (t->data.oper.right->tag==Var)) + if (strcmp(t->data.oper.left->data.name, + t->data.oper.right->data.name)==0) { + alter=1; + res->tag=Konst; + res->data.value=0.0; + } /* if */ + + /* (f-(-g)) -> (f+g) */ + if ((t->data.oper.right->tag==NegSign) && (alter==2)) { + alter=1; + res->tag=Oper; + res->data.oper.op=Add; + res->data.oper.left=TreeCreate(); + TreeCpy(res->data.oper.left, t->data.oper.left); + res->data.oper.right=TreeCreate(); + TreeCpy(res->data.oper.right, t->data.oper.right); + } /* if */ + + /* (-f-g) -> -(f+g) */ + if ((t->data.oper.left->tag==NegSign) && (alter==2)) { + alter=1; + res->tag=NegSign; + res->data.right=TreeCreate(); + res->data.right->tag=Oper; + res->data.right->data.oper.op=Add; + res->data.right->data.oper.left=TreeCreate(); + TreeCpy(res->data.right->data.oper.left, + t->data.oper.left->data.right); + res->data.right->data.oper.right=TreeCreate(); + TreeCpy(res->data.right->data.oper.right, t->data.oper.right); + } + break; + + case Mul: + + /* (Konst1*Konst2) -> Konst3 */ + if ((t->data.oper.left->tag==Konst) && + (t->data.oper.right->tag==Konst)) { + alter=1; + res->tag=Konst; + res->data.value=t->data.oper.left->data.value + *t->data.oper.right->data.value; + } /* if */ + + /* (f*0) -> 0 and (f*1) -> (f) */ + if ((t->data.oper.right->tag==Konst) && (alter==2)) { + if (t->data.oper.right->data.value==0.0) { + alter=1; + res->tag=Konst; + res->data.value=0.0; + }; /* if */ + if (t->data.oper.right->data.value==1.0) { + alter=1; + TreeCpy(res, t->data.oper.left); + } /* if */ + } /* if */ + + /* (0*f) -> 0 and (1*f) -> (f) */ + if ((t->data.oper.left->tag==Konst) && (alter==2)) { + if (t->data.oper.left->data.value==0.0) { + alter=1; + res->tag=Konst; + res->data.value=0.0; + } /* if */ + if (t->data.oper.left->data.value==1.0) { + alter=1; + TreeCpy(res, t->data.oper.right); + } /* if */ + } /* if */ + +#ifdef WORKING + /* (-1*f) -> (-f) */ + if ((t->data.oper.left->tag==Konst) && (alter==2)) + if (t->data.oper.left->data.value==-1.0) { + alter=1; + res->tag=NegSign; + res->data.right=TreeCreate(); + TreeCpy(res->data.right, t->data.oper.right); + } /* if */ + + /* (f*(-1)) -> (-f) */ + if ((t->data.oper.right->tag==Konst) && (alter==2)) + if (t->data.oper.right->data.value==-1.0) { + alter=1; + res->tag=NegSign; + res->data.right=TreeCreate(); + TreeCpy(res->data.right, t->data.oper.left); + } /* if */ +#endif + + break; + case Div: + if ((t->data.oper.left->tag==Konst) && + (t->data.oper.right->tag==Konst)) { + /* division by zero is not detected */ + alter=1; + res->tag=Konst; + res->data.value=t->data.oper.left->data.value + /t->data.oper.right->data.value; + } /* if */ + if ((t->data.oper.right->tag==Konst) && (alter==2)) { + if (t->data.oper.right->data.value==1.0) { + alter=1; + TreeCpy(res, t->data.oper.left); + } /* if */ + if (t->data.oper.right->data.value==0.0) { + alter=1; + res->tag=Konst; + res->data.value=0.0; + } /* if */ + } /* if */ + if ((t->data.oper.left->tag==Var) && (t->data.oper.right->tag==Var)) { + if (strcmp(t->data.oper.left->data.name, + t->data.oper.right->data.name)==0) { + alter=1; + res->tag=Konst; + res->data.value=1.0; + } /* if */ + } /* if */ + if ((t->data.oper.left->tag==Konst) && (alter==2)) + if (t->data.oper.left->data.value==0.0) { + alter=1; + res->tag=Konst; + res->data.value=0.0; + } /* if */ + break; + case Pow: + if ((t->data.oper.left->tag==Konst) && + (t->data.oper.right->tag==Konst)) { + alter=1; + res->tag=Konst; + res->data.value=pow(t->data.oper.left->data.value, + t->data.oper.right->data.value); + } /* if */ + if ((t->data.oper.right->tag==Konst) && (alter==2)) { + if (t->data.oper.right->data.value==1.0) { + alter=1; + TreeCpy(res, t->data.oper.left); + } /* if */ + if (t->data.oper.right->data.value==0.0) { + alter=1; + res->tag=Konst; + res->data.value=1.0; + } /* if */ + } /* if */ + break; + } /* switch */ + break; + case NegSign: + alter=2; + t=TreeCreate(); + TreeCpy(t, tin); + TreeReduce(t->data.right); + + /* (-(-f)) -> (f) */ + if (t->data.right->tag==NegSign) { + alter=1; + res->tag=t->data.right->data.right->tag; + res->data.right=TreeCreate(); + TreeCpy(res, t->data.right->data.right); + } /* if */ + + /* -(Constant) -> (-Constant) */ + if (t->data.right->tag==Konst) { + alter=1; + res->tag=Konst; + res->data.value=-t->data.right->data.value; + } /* if */ + break; + case Func: + alter=2; + t=TreeCreate(); + TreeCpy(t, tin); + TreeReduce(t->data.func.right); + break; + default: + /* Nothing */ + alter=0; + break; + }; /* switch tag */ + switch (alter) { + case 0: /* nothing altered */ + TreeCpy(res, tin); + break; + case 1: /* res is the result */ + break; + case 2: /* t is the result */ + TreeCpy(res, t); + break; + }; /* switch */ +/* + TreeKill(tin); + tin=TreeCreate(); +*/ + TreeCpy(tin, res); + TreeKill(res); + TreeKill(t); + } /* if */ + else { + fprintf(stderr, "ERROR in TreeReduce: NULL pointer.\nAborting kc - sorry.\n"); + exit(-1); + } +} /* TreeReduce */ + + +/**************************************************************************** + The following two procdures are used by TreePrint. +*****************************************************************************/ + +void SplitFP(double x, double *mantissa, int *exponent) { + + int i, sign; + char str[STRING_LENGTH]; + + *mantissa=0.0; + sprintf(str, "%e", x); + if (str[0]=='-') + sign=-1; + else + sign=1; + i=1; + while (str[i]!='e') { + *mantissa=*mantissa+(double)str[i]*pow(10.0, -(double)(i-1)); + i++; + } /* while */ + *mantissa=*mantissa*sign; + i+=2; + if (str[i]=='-') + sign=-1; + else + sign=1; + *exponent=10*(int)str[i+1]; + *exponent+=(int)str[i+2]; + *exponent*=sign; +} /* SplitFP */ + + +void LineBreak(FILE *out, int mode) { + + if ((len>=60)) { + fprintf(out, "\n"); + switch (mode) { + case 1: + fprintf(out, " &"); + break; + case 2: + break; + case 3: + /* nothing */ + break; + } /* switch mode */ + len=0; + } /* if */ +} /* LineBreak */ + + +/**************************************************************************** + The following routines are exported. +*************************************************************************** */ + + +int TreeGetError() { + + return tree_error; +} /* TreeGetError */ + + +Tree TreeCreate(void) { + + Tree t; + +#ifdef _USE_GARBAGE_COL_ + t=(Tree) GC_malloc(sizeof(TreeNode)); +#else + t=(Tree) malloc(sizeof(TreeNode)); +#endif + if (t==NULL) { + fprintf(stderr, "ERROR in TreeCreate: NULL pointer recieved.\nAborting kc - sorry.\n"); + exit(-1); + } + tree_error=0; + return t; +} /* TreeCreate */ + + +void TreeAdd(Tree t1, Tree t2) { + + Tree t; + + t=TreeCreate(); + t->tag=Oper; + t->data.oper.op=Add; + t->data.oper.left=TreeCreate(); + t->data.oper.right=TreeCreate(); + TreeCpy(t->data.oper.left, t1); + TreeCpy(t->data.oper.right, t2); + tree_error=0; + TreeReduce(t); + TreeCpy(t1, t); + TreeKill(t); +} /* TreeAdd */ + +void TreeSub(Tree t1, Tree t2) { + + Tree t; + + t=TreeCreate(); + t->tag=Oper; + t->data.oper.op=Sub; + t->data.oper.left=TreeCreate(); + t->data.oper.right=TreeCreate(); + TreeCpy(t->data.oper.left, t1); + TreeCpy(t->data.oper.right, t2); + tree_error=0; + TreeReduce(t); + TreeCpy(t1, t); + TreeKill(t); +} /* TreeSub */ + +void TreeMul(Tree t1, Tree t2) { + + Tree t; + + t=TreeCreate(); + t->tag=Oper; + t->data.oper.op=Mul; + t->data.oper.left=TreeCreate(); + t->data.oper.right=TreeCreate(); + TreeCpy(t->data.oper.left, t1); + TreeCpy(t->data.oper.right, t2); + tree_error=0; + TreeReduce(t); + TreeCpy(t1, t); + TreeKill(t); +} /* TreeMul */ + +void TreeDiv(Tree t1, Tree t2) { + + Tree t; + + t=TreeCreate(); + t->tag=Oper; + t->data.oper.op=Div; + t->data.oper.left=TreeCreate(); + t->data.oper.right=TreeCreate(); + TreeCpy(t->data.oper.left, t1); + TreeCpy(t->data.oper.right, t2); + tree_error=0; + TreeReduce(t); + TreeCpy(t1, t); + TreeKill(t); +} /* TreeDiv */ + +void TreePow(Tree t, Tree t2) { + + Tree res; + + res=TreeCreate(); + res->tag=Oper; + res->data.oper.op=Pow; + res->data.oper.left=TreeCreate(); + res->data.oper.right=TreeCreate(); + TreeCpy(res->data.oper.left, t); + TreeCpy(res->data.oper.right, t2); + TreeReduce(res); + tree_error=0; + TreeCpy(t, res); + TreeKill(res); +} /* TreePow */ + +void TreeSign(Tree t) { + + Tree res; + + res=TreeCreate(); + res->tag=NegSign; + res->data.right=TreeCreate(); + TreeCpy(res->data.right, t); + TreeReduce(res); +/* TreeKill(t); + t=TreeCreate(); */ + TreeCpy(t, res); + TreeKill(res); + tree_error=0; +} /* TreeSign */ + +void TreeAssignConst(Tree t, double val) { + + t->tag=Konst; + t->data.value=val; + tree_error=0; +} /* TreeAssignConst */ + + +void TreeAssignVar(Tree t, char *name) { + + t->tag=Var; + (void) strcpy(t->data.name, name); + tree_error=0; +} /* TreeAssignVar */ + + +void TreeSubstVar(Tree t, char* name, double val) { + + if (t==NULL) + tree_error=1; + else { + switch (t->tag) { + case Var: + if (strcmp(t->data.name, name)==0) { + t->tag=Konst; + t->data.value=val; + tree_error=0; + } /* if */ + break; + case Oper: + TreeSubstVar(t->data.oper.left, name, val); + TreeSubstVar(t->data.oper.right, name, val); + break; + case NegSign: + TreeSubstVar(t->data.right, name, val); + break; + case Func: + TreeSubstVar(t->data.func.right, name, val); + break; + } /* switch tag */ + tree_error=0; + } /* else */ + TreeReduce(t); +} /* TreeSubstVar */ + +void TreeSubstTree(Tree t, char *name, Tree value) { + + if (t==NULL) + tree_error=1; + else { + switch (t->tag) { + case Var: + if (strcmp(t->data.name, name)==0) + TreeCpy(t, value); + break; + case Oper: + TreeSubstTree(t->data.oper.left, name, value); + TreeSubstTree(t->data.oper.right, name, value); + break; + case Func: + TreeSubstTree(t->data.func.right, name, value); + break; + case NegSign: + TreeSubstTree(t->data.right, name, value); + break; + } /* switch */ + tree_error=0; + TreeReduce(t); + } /* else */ +} /* TreeSubstTree */ + +void TreeDerive(Tree res, Tree t, char* name) { + + Tree t1, t2, t3; + + tree_error=0; + if (t!=NULL) { + switch (t->tag) { + case Konst: + res->tag=Konst; + res->data.value=0.0; + break; + case Var: + res->tag=Konst; + if (strcmp(t->data.name, name)==0) + res->data.value=1.0; + else + res->data.value=0.0; + break; + case Oper: + switch (t->data.oper.op) { + case Add: + res->tag=Oper; + res->data.oper.op=Add; + res->data.oper.left=TreeCreate(); + res->data.oper.right=TreeCreate(); + TreeDerive(res->data.oper.left, t->data.oper.left, name); + TreeDerive(res->data.oper.right, t->data.oper.right, name); + break; + case Sub: + res->tag=Oper; + res->data.oper.op=Sub; + res->data.oper.left=TreeCreate(); + res->data.oper.right=TreeCreate(); + TreeDerive(res->data.oper.left, t->data.oper.left, name); + TreeDerive(res->data.oper.right, t->data.oper.right, name); + break; + case Mul: + res->data.oper.left=TreeCreate(); + res->data.oper.right=TreeCreate(); + res->tag=Oper; + res->data.oper.op=Add; + res->data.oper.left->tag=Oper; + res->data.oper.left->data.oper.op=Mul; + res->data.oper.right->tag=Oper; + res->data.oper.right->data.oper.op=Mul; + res->data.oper.right->data.oper.left=TreeCreate(); + res->data.oper.right->data.oper.right=TreeCreate(); + res->data.oper.left->data.oper.left=TreeCreate(); + res->data.oper.left->data.oper.right=TreeCreate(); + TreeDerive(res->data.oper.left->data.oper.left, + t->data.oper.left, name); + TreeCpy(res->data.oper.left->data.oper.right, t->data.oper.right); + TreeCpy(res->data.oper.right->data.oper.left, t->data.oper.left); + TreeDerive(res->data.oper.right->data.oper.right, + t->data.oper.right, name); + break; + case Div: + res->tag=Oper; + res->data.oper.op=Div; + res->data.oper.left=TreeCreate(); + res->data.oper.right=TreeCreate(); + res->data.oper.right->tag=Oper; + res->data.oper.right->data.oper.op=Pow; + res->data.oper.right->data.oper.left=TreeCreate(); + res->data.oper.right->data.oper.right=TreeCreate(); + res->data.oper.right->data.oper.right->tag=Konst; + res->data.oper.right->data.oper.right->data.value=2.0; + TreeCpy(res->data.oper.right->data.oper.left, t->data.oper.right); + res->data.oper.left->tag=Oper; + res->data.oper.left->data.oper.op=Sub; + res->data.oper.left->data.oper.left=TreeCreate(); + res->data.oper.left->data.oper.right=TreeCreate(); + res->data.oper.left->data.oper.left->tag=Oper; + res->data.oper.left->data.oper.left->data.oper.op=Mul; + res->data.oper.left->data.oper.left->data.oper.left=TreeCreate(); + res->data.oper.left->data.oper.left->data.oper.right=TreeCreate(); + TreeCpy(res->data.oper.left->data.oper.left->data.oper.left, + t->data.oper.right); + TreeDerive(res->data.oper.left->data.oper.left->data.oper.right, + t->data.oper.left, name); + res->data.oper.left->data.oper.right->tag=Oper; + res->data.oper.left->data.oper.right->data.oper.op=Mul; + res->data.oper.left->data.oper.right->data.oper.left=TreeCreate(); + res->data.oper.left->data.oper.right->data.oper.right=TreeCreate(); + TreeCpy(res->data.oper.left->data.oper.right->data.oper.left, + t->data.oper.left); + TreeDerive(res->data.oper.left->data.oper.right->data.oper.right, + t->data.oper.right, name); + break; + case Pow: /* (f^g)' = g*f^(g-1)*f' + f^g*log(f)*g' */ + t1=TreeCreate(); + t2=TreeCreate(); + TreeAssignConst(t1, 1.0); + TreeCpy(t2, t->data.oper.right); + TreeSub(t2, t1); + TreeKill(t1); + t1=TreeCreate(); + TreeCpy(t1, t->data.oper.left); + TreePow(t1, t2); + TreeKill(t2); + t2=TreeCreate(); + TreeDerive(t2, t->data.oper.left, name); + TreeMul(t1, t2); + TreeMul(t1, t->data.oper.right); /* t1 is now first term */ + TreeKill(t2); + t2=TreeCreate(); + + TreeCpy(t2, t->data.oper.left); + TreePow(t2, t->data.oper.right); + t3=TreeCreate(); + TreeCpy(t3, t->data.oper.left); + TreeApplyFunc(&t3, Ln); + TreeMul(t2, t3); + TreeKill(t3); + t3=TreeCreate(); + TreeDerive(t3, t->data.oper.right, name); + TreeMul(t2, t3); /* t2 is now second term */ + TreeKill(t3); + TreeCpy(res, t1); + TreeKill(t1); + TreeAdd(res, t2); /* res is the final result */ + TreeKill(t2); + break; + } /* switch */ + break; + case Func: + res->tag=Oper; + res->data.oper.op=Mul; + res->data.oper.left=TreeCreate(); + res->data.oper.right=TreeCreate(); + TreeDerive(res->data.oper.left, t->data.func.right, name); + switch (t->data.func.fun) { + case Exp: + res->data.oper.right->tag=Func; + res->data.oper.right->data.func.right=TreeCreate(); + TreeCpy(res->data.oper.right->data.func.right, t->data.func.right); + res->data.oper.right->data.func.fun=Exp; + break; + case Cos: + res->data.oper.right->tag=NegSign; + res->data.oper.right->data.right=TreeCreate(); + res->data.oper.right->data.right->tag=Func; + res->data.oper.right->data.right->data.func.right=TreeCreate(); + res->data.oper.right->data.right->data.func.fun=Sin; + TreeCpy(res->data.oper.right->data.right->data.func.right, + t->data.func.right); + break; + case Sin: + res->data.oper.right->tag=Func; + res->data.oper.right->data.func.fun=Cos; + res->data.oper.right->data.func.right=TreeCreate(); + TreeCpy(res->data.oper.right->data.func.right, t->data.func.right); + break; + case Cosh: + res->data.oper.right->tag=Func; + res->data.oper.right->data.func.fun=Sinh; + res->data.oper.right->data.func.right=TreeCreate(); + TreeCpy(res->data.oper.right->data.func.right, t->data.func.right); + break; + case Sinh: + res->data.oper.right->tag=Func; + res->data.oper.right->data.func.fun=Cosh; + res->data.oper.right->data.func.right=TreeCreate(); + TreeCpy(res->data.oper.right->data.func.right, t->data.func.right); + break; + case Atan: + res->data.oper.op=Div; + TreeDerive(res->data.oper.left, t->data.oper.right, name); + res->data.oper.right->tag=Oper; + res->data.oper.right->data.oper.op=Add; + res->data.oper.right->data.oper.left=TreeCreate(); + res->data.oper.right->data.oper.right=TreeCreate(); + res->data.oper.right->data.oper.left->tag=Konst; + res->data.oper.right->data.oper.left->data.value=1.0; + res->data.oper.right->data.oper.right->tag=Oper; + res->data.oper.right->data.oper.right->data.oper.op=Pow; + res->data.oper.right->data.oper.right->data.oper.left=TreeCreate(); + res->data.oper.right->data.oper.right->data.oper.right=TreeCreate(); + TreeCpy(res->data.oper.right->data.oper.right->data.oper.left, + t->data.func.right); + res->data.oper.right->data.oper.right->data.oper.right->tag=Konst; + res->data.oper.right->data.oper.right->data.oper.right->data.value + =2.0; + break; + case Asinh: + res->data.oper.op=Div; + TreeDerive(res->data.oper.left, t->data.oper.right, name); + res->data.oper.right->tag=Oper; + res->data.oper.right->data.oper.op=Pow; + res->data.oper.right->data.oper.left=TreeCreate(); + res->data.oper.right->data.oper.right=TreeCreate(); + res->data.oper.right->data.oper.left->tag=Oper; + res->data.oper.right->data.oper.left->data.oper.op=Pow; + res->data.oper.right->data.oper.left->data.oper.left=TreeCreate(); + res->data.oper.right->data.oper.left->data.oper.right=TreeCreate(); + res->data.oper.right->data.oper.left->data.oper.left->tag=Oper; + res->data.oper.right->data.oper.left->data.oper.left->data.oper.op + =Add; + res->data.oper.right->data.oper.left->data.oper.left->data.oper.left + =TreeCreate(); + res->data.oper.right->data.oper.left->data.oper.left->data.oper.right + =TreeCreate(); + res->data.oper.right->data.oper.left->data.oper.left->data.oper.left->tag=Oper; + res->data.oper.right->data.oper.left->data.oper.left->data.oper.left->data.oper.op=Pow; + res->data.oper.right->data.oper.left->data.oper.left->data.oper.left->data.oper.left=TreeCreate(); + res->data.oper.right->data.oper.left->data.oper.left->data.oper.left->data.oper.right=TreeCreate(); + TreeCpy(res->data.oper.right->data.oper.left->data.oper.left->data.oper.left->data.oper.left, t->data.func.right); + res->data.oper.right->data.oper.left->data.oper.left->data.oper.left->data.oper.right->tag=Konst; + res->data.oper.right->data.oper.left->data.oper.left->data.oper.left->data.oper.right->data.value=2.0; + res->data.oper.right->data.oper.left->data.oper.left->data.oper.right->tag=Konst; + res->data.oper.right->data.oper.left->data.oper.left->data.oper.right->data.value=1.0; + res->data.oper.right->data.oper.left->data.oper.right->tag=Konst; + res->data.oper.right->data.oper.left->data.oper.right->data.value=0.5; + break; + case Atanh: + res->data.oper.op=Div; + TreeDerive(res->data.oper.left, t->data.oper.right, name); + res->data.oper.right->tag=Oper; + res->data.oper.right->data.oper.op=Sub; + res->data.oper.right->data.oper.left=TreeCreate(); + res->data.oper.right->data.oper.right=TreeCreate(); + res->data.oper.right->data.oper.left->tag=Konst; + res->data.oper.right->data.oper.left->data.value=1.0; + res->data.oper.right->data.oper.right->tag=Oper; + res->data.oper.right->data.oper.right->data.oper.op=Pow; + res->data.oper.right->data.oper.right->data.oper.left=TreeCreate(); + res->data.oper.right->data.oper.right->data.oper.right=TreeCreate(); + TreeCpy(res->data.oper.right->data.oper.right->data.oper.left, + t->data.func.right); + res->data.oper.right->data.oper.right->data.oper.right->tag=Konst; + res->data.oper.right->data.oper.right->data.oper.right->data.value=2.0; + break; + case Tan: + res->data.oper.op=Div; + TreeDerive(res->data.oper.left, t->data.oper.right, name); + res->data.oper.right->tag=Oper; + res->data.oper.right->data.oper.op=Pow; + res->data.oper.right->data.oper.right=TreeCreate(); + res->data.oper.right->data.oper.left=TreeCreate(); + res->data.oper.right->data.oper.left->tag=Func; + res->data.oper.right->data.func.fun=Cos; + res->data.oper.right->data.func.right=TreeCreate(); + TreeCpy(res->data.oper.right->data.func.right, t->data.func.right); + res->data.oper.right->data.oper.right->tag=Konst; + res->data.oper.right->data.oper.right->data.value=2.0; + break; + case Tanh: + res->data.oper.op=Div; + TreeDerive(res->data.oper.left, t->data.oper.right, name); + res->data.oper.right->tag=Oper; + res->data.oper.right->data.oper.op=Pow; + res->data.oper.right->data.oper.right=TreeCreate(); + res->data.oper.right->data.oper.left=TreeCreate(); + res->data.oper.right->data.oper.left->tag=Func; + res->data.oper.right->data.func.fun=Cosh; + res->data.oper.right->data.func.right=TreeCreate(); + TreeCpy(res->data.oper.right->data.func.right, t->data.func.right); + res->data.oper.right->data.oper.right->tag=Konst; + res->data.oper.right->data.oper.right->data.value=2.0; + break; + case Asin: + res->data.oper.op=Div; + res->data.oper.left=TreeCreate(); + res->data.oper.right=TreeCreate(); + TreeDerive(res->data.oper.left, t->data.func.right, name); + res->data.oper.right->tag=Oper; + res->data.oper.right->data.oper.op=Pow; + res->data.oper.right->data.oper.left=TreeCreate(); + res->data.oper.right->data.oper.right=TreeCreate(); + res->data.oper.right->data.oper.left->tag=Oper; + res->data.oper.right->data.oper.left->data.oper.op=Sub; + res->data.oper.right->data.oper.left->data.oper.left=TreeCreate(); + res->data.oper.right->data.oper.left->data.oper.right=TreeCreate(); + res->data.oper.right->data.oper.left->data.oper.left->tag=Konst; + res->data.oper.right->data.oper.left->data.oper.left->data.value=1.0; + res->data.oper.right->data.oper.left->data.oper.right->tag=Oper; + res->data.oper.right->data.oper.left->data.oper.right->data.oper.op=Pow; + res->data.oper.right->data.oper.left->data.oper.right->data.oper.left=TreeCreate(); + res->data.oper.right->data.oper.left->data.oper.right->data.oper.right=TreeCreate(); + TreeCpy(res->data.oper.right->data.oper.left->data.oper.right->data.oper.left, t->data.func.right); + res->data.oper.right->data.oper.left->data.oper.right->data.oper.right->tag=Konst; + res->data.oper.right->data.oper.left->data.oper.right->data.oper.right->data.value=2.0; + res->data.oper.right->data.oper.right->tag=Konst; + res->data.oper.right->data.oper.right->data.value=0.5; + break; + case Acos: + res->data.oper.op=Div; + res->data.oper.left=TreeCreate(); + res->data.oper.right=TreeCreate(); + res->data.oper.left->tag=NegSign; + TreeDerive(res->data.oper.left->data.right, t->data.func.right, name); + res->data.oper.right->tag=Oper; + res->data.oper.right->data.oper.op=Pow; + res->data.oper.right->data.oper.left=TreeCreate(); + res->data.oper.right->data.oper.right=TreeCreate(); + res->data.oper.right->data.oper.left->tag=Oper; + res->data.oper.right->data.oper.left->data.oper.op=Sub; + res->data.oper.right->data.oper.left->data.oper.left=TreeCreate(); + res->data.oper.right->data.oper.left->data.oper.right=TreeCreate(); + res->data.oper.right->data.oper.left->data.oper.left->tag=Konst; + res->data.oper.right->data.oper.left->data.oper.left->data.value=1.0; + res->data.oper.right->data.oper.left->data.oper.right->tag=Oper; + res->data.oper.right->data.oper.left->data.oper.right->data.oper.op=Pow; + res->data.oper.right->data.oper.left->data.oper.right->data.oper.left=TreeCreate(); + res->data.oper.right->data.oper.left->data.oper.right->data.oper.right=TreeCreate(); + TreeCpy(res->data.oper.right->data.oper.left->data.oper.right->data.oper.left, t->data.func.right); + res->data.oper.right->data.oper.left->data.oper.right->data.oper.right->tag=Konst; + res->data.oper.right->data.oper.left->data.oper.right->data.oper.right->data.value=2.0; + res->data.oper.right->data.oper.right->tag=Konst; + res->data.oper.right->data.oper.right->data.value=0.5; + break; + case Acosh: + fprintf(stderr, "TreeDerive: dAcosh/dx not implemented\n"); + tree_error=4; + break; + case Log: + res->data.oper.right->tag=Oper; + res->data.oper.right->data.oper.op=Div; + res->data.oper.right->data.oper.left=TreeCreate(); + res->data.oper.right->data.oper.right=TreeCreate(); + res->data.oper.right->data.oper.left->tag=Konst; + res->data.oper.right->data.oper.left->data.value=0.4342944819; + TreeCpy(res->data.oper.right->data.oper.right, t->data.func.right); + break; + }; /* switch */ + break; /* Functions */ + case NegSign: + res->tag=NegSign; + res->data.right=TreeCreate(); + TreeDerive(res->data.right, t->data.right, name); + break; + }; /* switch */ + TreeReduce(res); + }; /* if */ +} /* TreeDerive */ + +double TreeEval(Tree t) { + + double c1, c2, res; + + if (t==NULL) + return 0.0; + else { + switch (t->tag) { + case Var: + tree_error=NoEval; + res=0.0; + break; + case Konst: + res=t->data.value; + tree_error=TreeNoError; + break; + case Oper: + c1=TreeEval(t->data.oper.left); + if (tree_error==TreeNoError) { + c2=TreeEval(t->data.oper.right); + if (tree_error==TreeNoError) { + switch (t->data.oper.op) { + case Add: + res=c1+c2; + break; + case Sub: + res=c1-c2; + break; + case Mul: + res=c1*c2; + break; + case Div: + res=c1/c2; + break; + case Pow: + res=pow(c1, c2); + break; + }; /* switch */ + tree_error=TreeNoError; + } /* if */ + } /* if */ + break; + case NegSign: + res=-TreeEval(t->data.right); + break; + case Func: + res=TreeEval(t->data.func.right); + if (tree_error==TreeNoError) { + switch (t->data.func.fun) { + case Exp: + res=exp(res); + break; + case Ln: + res=log(res); + break; + case Log: + res=log10(res); + break; + case Sin: + res=sin(res); + break; + case Cos: + res=cos(res); + break; + case Tan: + res=tan(res); + break; + case Sinh: + res=sinh(res); + break; + case Cosh: + res=cosh(res); + break; + case Tanh: + res=tanh(res); + break; + case Asin: + res=asin(res); + break; + case Acos: + res=acos(res); + break; + case Atan: + res=atan(res); + break; + case Asinh: + /* res=asinh(res); */ + break; + case Acosh: + /* res=acosh(res); */ + break; + case Atanh: + /* res=atanh(res); */ + break; + } /* switch */ + } /* if */ + break; + } /* switch */ + } /* else */ + return res; +} /* TreeEval */ + +/* The following procedure is 'internal' */ + +void TreePrintXtra(Tree t, int mode, FILE *output) { + +/* Mode: 1 - (HP) Fortran 77 */ +/* 2 - (HP) Pascal */ +/* 3 - ANSI C */ + + int i, expo; + double mant; + + switch (mode) { + case 1: + switch (t->tag) { + case Oper: + fprintf(output, "("); + len++; + LineBreak(output, mode); + TreePrintXtra(t->data.oper.left, mode, output); + switch (t->data.oper.op) { + case Add: + fprintf(output, "+"); + len++; + LineBreak(output, mode); + break; + case Sub: + fprintf(output, "-"); + len++; + LineBreak(output, mode); + break; + case Div: + fprintf(output, "/"); + len++; + LineBreak(output, mode); + break; + case Mul: + fprintf(output, "*"); + len++; + LineBreak(output, mode); + break; + case Pow: + fprintf(output, "**"); + len=len+2; + LineBreak(output, mode); + break; + }; /* switch */ + TreePrintXtra(t->data.oper.right, mode, output); + fprintf(output, ")"); + len++; + LineBreak(output, mode); + break; + case Konst: + fprintf(output, "(%e)", t->data.value); + len+=15; + /* + if (fmod(t->data.value, 1.0)==0.0) { + fprintf(output, "(%d)", (int)t->data.value); + len+=4; + } else { + fprintf(output, "(%e)", t->data.value); + len+=15; + }*/ /* if */ + LineBreak(output, mode); + break; + case Var: + len=len+strlen(t->data.name); + fprintf(output, "%s", t->data.name); + LineBreak(output, mode); + break; + case Func: + switch (t->data.func.fun) { + case Exp: + fprintf(output, "EXP("); + len+=4; + break; + case Log: + fprintf(output, "LOG10("); + len+=6; + break; + case Ln: + fprintf(output, "LOG("); + len+=4; + break; + case Sin: + fprintf(output, "SIN("); + len+=4; + break; + case Cos: + fprintf(output, "COS("); + len+=4; + break; + case Asinh: + fprintf(output, "ASINH("); + len+=6; + break; + case Acosh: + fprintf(output, "ACOSH("); + len+=6; + break; + case Atanh: + fprintf(output, "ATANH("); + len+=6; + break; + case Tan: + fprintf(output, "TAN("); + len+=4; + break; + } /* switch */ + LineBreak(output, mode); + TreePrintXtra(t->data.func.right, mode, output); + fprintf(output, ")"); + len++; + LineBreak(output, mode); + break; /* Func */ + case NegSign: + fprintf(output, "(-("); + len+=2; + LineBreak(output, mode); + TreePrintXtra(t->data.right, mode, output); + fprintf(output, "))"); + len++; + LineBreak(output, mode); + break; /* NegSign */ + }; /* switch */ + break; + case 2: + switch (t->tag) { + case Oper: + fprintf(output, "("); + len++; + LineBreak(output, mode); + switch (t->data.oper.op) { + case Add: + TreePrintXtra(t->data.oper.left, mode, output); + fprintf(output, "+"); + len++; + LineBreak(output, mode); + TreePrintXtra(t->data.oper.right, mode, output); + break; + case Sub: + TreePrintXtra(t->data.oper.left, mode, output); + fprintf(output, "-"); + len++; + LineBreak(output, mode); + TreePrintXtra(t->data.oper.right, mode, output); + break; + case Div: + TreePrintXtra(t->data.oper.left, mode, output); + fprintf(output, "/"); + len++; + LineBreak(output, mode); + TreePrintXtra(t->data.oper.right, mode, output); + break; + case Mul: + TreePrintXtra(t->data.oper.left, mode, output); + fprintf(output, "*"); + len++; + LineBreak(output, mode); + TreePrintXtra(t->data.oper.right, mode, output); + break; + case Pow: + if (t->data.oper.right->tag==Konst) { + if (ceil(t->data.oper.right->data.value)==floor(t->data.oper.right->data.value)) { + TreePrintXtra(t->data.oper.left, mode, output); + for(i=1; i<((int)(t->data.oper.right->data.value)); i++) { + fprintf(output, "*"); + TreePrintXtra(t->data.oper.left, mode, output); + len++; + LineBreak(output, mode); + } + } else { + fprintf(output, "EXP("); /* Pascal has no power operator!! */ + len+=4; + LineBreak(output, mode); + TreePrintXtra(t->data.oper.right, mode, output); + fprintf(output, "*LOG("); + len+=5; + LineBreak(output, mode); + TreePrintXtra(t->data.oper.left, mode, output); + fprintf(output, "))"); + len+=2; + LineBreak(output, mode); + } /* if ... else ... */ + } else { + fprintf(output, "EXP("); /* Pascal has no power operator!! */ + len+=4; + LineBreak(output, mode); + TreePrintXtra(t->data.oper.right, mode, output); + fprintf(output, "*LOG("); + len+=5; + LineBreak(output, mode); + TreePrintXtra(t->data.oper.left, mode, output); + fprintf(output, "))"); + len+=2; + LineBreak(output, mode); + } + break; + } /* switch */ + fprintf(output, ")"); + len++; + LineBreak(output, mode); + break; + case Konst: + if (fmod(t->data.value, 1.0)==0.0) { + fprintf(output, "(%d)", (int)t->data.value); + len+=5; + } else { + fprintf(output, "(%e)", t->data.value); + len+=15; + } /* if */ + LineBreak(output, mode); + break; + case Var: + fprintf(output, "%s", t->data.name); + len+=strlen(t->data.name); + LineBreak(output, mode); + break; + case Func: + switch (t->data.func.fun) { + case Exp: + fprintf(output, "exp("); + len+=4; + break; + case Log: + fprintf(output, "log10("); + len+=6; + break; + case Ln: + fprintf(output, "log("); + len+=4; + break; + case Sin: + fprintf(output, "sin("); + len+=4; + break; + case Cos: + fprintf(output, "cos("); + len+=4; + break; + case Tan: + fprintf(output, "tan("); + len+=4; + break; + case Sinh: + fprintf(output, "sinh("); + len+=5; + break; + case Cosh: + fprintf(output, "cosh("); + len+=5; + break; + case Tanh: + fprintf(output, "tanh("); + len+=5; + break; + case Asin: + fprintf(output, "asin("); + len+=5; + break; + case Acos: + fprintf(output, "acos("); + len+=5; + break; + case Atan: + fprintf(output, "atan("); + len+=5; + break; + case Asinh: + fprintf(output, "asinh("); + len+=6; + break; + case Acosh: + fprintf(output, "acosh("); + len+=6; + break; + case Atanh: + fprintf(output, "atanh("); + len+=6; + break; + } /* switch */ + LineBreak(output, mode); + TreePrintXtra(t->data.func.right, mode, output); + fprintf(output, ")"); + len++; + LineBreak(output, mode); + break; /* Func */ + case NegSign: + fprintf(output, "(-("); + len+=2; + LineBreak(output, mode); + TreePrintXtra(t->data.right, mode, output); + fprintf(output, "))"); + len++; + LineBreak(output, mode); + break; /* NegSign */ + }; /* switch */ + break; + case 3: /* The C mode */ + switch (t->tag) { + case Var: + fprintf(output, "%s", t->data.name); + len+=strlen(t->data.name); + LineBreak(output, mode); + break; + case Konst: + fprintf(output, "%e", t->data.value); + len+=15; + LineBreak(output, mode); + break; + case Oper: + fprintf(output, "("); + len++; + LineBreak(output, mode); + switch (t->data.oper.op) { + case Div: + TreePrintXtra(t->data.oper.left, mode, output); + fprintf(output, "/"); + len++; + LineBreak(output, mode); + TreePrintXtra(t->data.oper.right, mode, output); + break; + case Mul: + TreePrintXtra(t->data.oper.left, mode, output); + fprintf(output, "*"); + len++; + LineBreak(output, mode); + TreePrintXtra(t->data.oper.right, mode, output); + break; + case Add: + TreePrintXtra(t->data.oper.left, mode, output); + fprintf(output, "+"); + len++; + LineBreak(output, mode); + TreePrintXtra(t->data.oper.right, mode, output); + break; + case Sub: + TreePrintXtra(t->data.oper.left, mode, output); + fprintf(output, "-"); + len++; + LineBreak(output, mode); + TreePrintXtra(t->data.oper.right, mode, output); + break; + case Pow: + if (t->data.oper.right->tag==Konst) { + if (ceil(t->data.oper.right->data.value)==floor(t->data.oper.right->data.value)) { + TreePrintXtra(t->data.oper.left, mode, output); + for(i=1; i<((int)(ceil(t->data.oper.right->data.value))); i++) { + fprintf(output, "*"); + len++; + LineBreak(output, mode); + TreePrintXtra(t->data.oper.left, mode, output); + } /* for i */ + } else { + fprintf(output, "pow("); + len+=4; + LineBreak(output, mode); + TreePrintXtra(t->data.oper.left, mode, output); + fprintf(output, ","); + len++; + LineBreak(output, mode); + TreePrintXtra(t->data.oper.right, mode, output); + fprintf(output, ")"); + len++; + LineBreak(output, mode); + } /* if ... else ... */ + } else { + fprintf(output, "pow("); + len+=4; + LineBreak(output, mode); + TreePrintXtra(t->data.oper.left, mode, output); + fprintf(output, ","); + len++; + LineBreak(output, mode); + TreePrintXtra(t->data.oper.right, mode, output); + fprintf(output, ")"); + len++; + LineBreak(output, mode); + } /* if ... else ... */ + break; + } /* switch oper */ + fprintf(output, ")"); + len++; + LineBreak(output, mode); + break; /* Oper */ + case Func: + switch (t->data.func.fun) { + case Exp: + fprintf(output, "exp("); + len+=4; + break; + case Log: + fprintf(output, "log10("); + len+=6; + break; + case Ln: + fprintf(output, "log("); + len+=4; + break; + case Sin: + fprintf(output, "sin("); + len+=4; + break; + case Cos: + fprintf(output, "cos("); + len+=4; + break; + case Tan: + fprintf(output, "tan("); + len+=4; + break; + case Sinh: + fprintf(output, "sinh("); + len+=5; + break; + case Cosh: + fprintf(output, "cosh("); + len+=5; + break; + case Tanh: + fprintf(output, "tanh("); + len+=5; + break; + case Asin: + fprintf(output, "asin("); + len+=5; + break; + case Acos: + fprintf(output, "acos("); + len+=5; + break; + case Atan: + fprintf(output, "atan("); + len+=5; + break; + case Asinh: + fprintf(output, "asinh("); + len+=6; + break; + case Acosh: + fprintf(output, "acosh("); + len+=6; + break; + case Atanh: + fprintf(output, "atanh("); + len+=6; + break; + } /* switch */ + LineBreak(output, mode); + TreePrintXtra(t->data.func.right, mode, output); + fprintf(output, ")"); + len++; + LineBreak(output, mode); + break; /* Func */ + case NegSign: + fprintf(output, "(-("); + len+=2; + LineBreak(output, mode); + TreePrintXtra(t->data.right, mode, output); + fprintf(output, "))"); + len++; + LineBreak(output, mode); + break; /* NegSign */ + }; /* switch tag */ + break; /* mode 3 */ + }; /* switch */ +} /* TreePrintXtra */ + + +void TreePrint(Tree t, int mode, FILE *output) { + + len=10; + TreePrintXtra(t, mode, output); +} /* TreePrint */ + +void TreeCpy(Tree res, Tree t) { + + if (t==NULL) { + res=NULL; + tree_error=NoTree; + } /* if */ + else { + switch (t->tag) { + case Oper: + res->tag=Oper; + res->data.oper.left=TreeCreate(); + res->data.oper.right=TreeCreate(); + res->data.oper.op=t->data.oper.op; + TreeCpy(res->data.oper.left, t->data.oper.left); + TreeCpy(res->data.oper.right, t->data.oper.right); + break; + case Konst: + res->tag=Konst; + res->data.value=t->data.value; + break; + case Var: + res->tag=Var; + (void) strcpy(res->data.name, t->data.name); + break; + case Func: + res->tag=Func; + res->data.func.fun=t->data.func.fun; + res->data.func.right=TreeCreate(); + TreeCpy(res->data.func.right, t->data.func.right); + break; + case NegSign: + res->tag=NegSign; + res->data.right=TreeCreate(); + TreeCpy(res->data.right, t->data.right); + break; + }; /* switch */ + }; /* else */ +} /* TreeCpy */ + +void TreeKill(Tree t) { + +#ifndef _USE_GARBAGE_COL_ + if (t!=NULL) { + switch (t->tag) { + case Oper: + TreeKill(t->data.oper.left); + TreeKill(t->data.oper.right); + break; + case Var: + break; + case Func: + TreeKill(t->data.func.right); + break; + case NegSign: + TreeKill(t->data.right); + break; + } + free((MALLOCTYPE *) t); + } +#endif +} /* TreeKill */ + +void TreeApplyFunc(Tree *t, Function fun) { + + Tree temp; + + temp=TreeCreate(); + temp->tag=Func; + temp->data.func.fun=fun; + temp->data.func.right=TreeCreate(); + TreeCpy(temp->data.func.right, *t); + TreeReduce(temp); + TreeKill(*t); + *t=TreeCreate(); + TreeCpy(*t, temp); + TreeKill(temp); + tree_error=0; +} /* TreeApplyFunc */ diff --git a/src/symbmath.h b/src/symbmath.h new file mode 100644 index 0000000..d4952a4 --- /dev/null +++ b/src/symbmath.h @@ -0,0 +1,70 @@ +/**************************************************************************** + Symbolic mathematics in ANSI-C. + + CopyWrong 1992-1994 by + Kenneth Geisshirt (kneth@osc.kiku.dk) + Department of Theoretical Chemistry + H.C. Orsted Institute + Universitetsparken 5 + 2100 Copenhagen + Denmark + + See kc.tex for details. + + Last updated: 27 September 1994 +****************************************************************************/ + +#ifndef _SYMBMATH_ +#define _SYMBMATH_ +#include +#include "config.h" + +#define TreeNoError 1 +#define NoEval 2 +#define NoTree 3 + +typedef enum {Konst, Var, Oper, Func, NegSign} TreeTag; +typedef enum {Add, Sub, Mul, Div, Pow} TreeOper; +typedef enum {Exp, Sin, Cos, Tan, Ln, Log, Cosh, Sinh, Tanh, Asin, + Acos, Atan, Acosh, Asinh, Atanh} Function; + +struct TreeCell { + TreeTag tag; + union { + double value; /* constant */ + char name[STRING_LENGTH]; /* variable */ + struct { + TreeOper op; + struct TreeCell *left, *right; + } oper; /* operation */ + struct { + Function fun; + struct TreeCell *right; + } func; + struct TreeCell *right; /* negative sign */ + } data; +}; +typedef struct TreeCell TreeNode; +typedef TreeNode *Tree; + +int tree_error, len, left, right; + +extern int TreeGetError(); +extern Tree TreeCreate(void); +extern void TreeAdd(Tree, Tree); +extern void TreeSub(Tree, Tree); +extern void TreeMul(Tree, Tree); +extern void TreeDiv(Tree, Tree); +extern void TreePow(Tree, Tree); +extern void TreeSign(Tree); +extern void TreeAssignConst(Tree, double); +extern void TreeAssignVar(Tree, char *); +extern void TreeSubstVar(Tree, char *, double); +extern void TreeDerive(Tree, Tree, char *); +extern double TreeEval(Tree); +extern void TreePrint(Tree, int, FILE *); +extern void TreeCpy(Tree, Tree); +extern void TreeKill(Tree); +extern void TreeSubstTree(Tree, char *, Tree); +extern void TreeApplyFunc(Tree *, Function); +#endif diff --git a/src/tableman.c b/src/tableman.c new file mode 100644 index 0000000..a34689b --- /dev/null +++ b/src/tableman.c @@ -0,0 +1,1698 @@ +/************************************************************************** + Implementation of the Symbol Table Manager for kc. + + (C) Copyright 1992-1996 by + Kenneth Geisshirt (kneth@fatou.ruc.dk) Keld Nielsen (kn@kin.kiku.dk) + Dept. of Life Sciences and Chemistry Dept. of Theoretical Chemistry + Roskilde University University of Copenhagen + P.O. Box 260 Universitetsparken 5 + 4000 Roskilde 2100 Copenhagen East + Denmark Denmark + + Last updated: 27 March 1996 by KG +***************************************************************************/ + +#include "config.h" + +#include +#include +#include +#include "tableman.h" + +void SetupTableMan(void) { + + sym_last=0; + react_last=0; + con_last=0; + current=0; + dyn_last=0; + expr_last=0; + param_last=0; + prn_last=0; + str_last=0; + error=NoError; + autonom_system=0; +} /* SetupTableMan */ + +TableErrors GetError(void) { + + return error; +} /* GetError */ + +int GetCurrentReaction(void) { + + return current; +} /* GetCurrentReaction */ + +int NoOfReact(void) { + + return react_last; +} /* NoOfReact */ + +void NewSpecie(char *name, double charge) { + + int i, finished, j; + + if (sym_last==SymSize) + error=TooManySpec; + else { + finished=0; + i=0; + while ((i, 0 = =, 1 = < */ + + int i, finished; + + i=0; + finished=0; + while ((i, 0 = =, 1 = < */ + + int i, finished; + + i=0; + finished=0; + while ((i specie is radical */ + + (void) strcpy(rename, name); + if (charge==FLT_MAX) + (void) strcat(rename, "_rad\0"); + else if (charge==0.0) + /* nothing */ ; + else { + (void) strcat(rename, "_\0"); + if (charge>=0.0) + for(i=1; i<=(int)charge; i++) + (void) strcat(rename, "p\0"); + else + for(i=1; i<=-(int)charge; i++) + (void) strcat(rename, "m\0"); + } /* else */ +} /* RenameSpec */ + +int NoOfSpec(void) { + + int i, count; + + count=0; + for(i=0;i0) && (i left-to-right + way==2 <=> right-to-left +****/ + + int i, finished; + + finished=0; + i=0; + while ((i left-to-right + way==2 <=> right-to-left +****/ + + int i, finished; + + finished=0; + i=0; + while ((i=dyn_last) + error=NotFound; + else { + strcpy(name, dyntable[i-1].name); + error=NoError; + } /* else */ +} /* GetDynVarNo */ + +void NewExpr(char *name, Tree t) { + + int i, found; + + if (expr_last>=ExprSize) + error=TooManyExpr; + else { + i=0; + found=0; + while ((iexpr_last) { + error=NotFound; + t=NULL; + } /* if */ + else { + error=NoError; + strcpy(name, exprtable[no-1].name); + TreeCpy(t, exprtable[no-1].expr); + } /* else */ +} /* GetExprNo */ + +int IsVarParameter(char *name) { + +/**** + 1 : Variable is parameter + 0 : otherwise +****/ + + int found, i; + + i=0; + found=0; + while ((i<=expr_last) && (found==0)) { + if (strcmp(name, exprtable[i].name)==0) + found=1; + else + i++; + } /* while */ + return found; +} /* IsVarParameter */ + +void NewConstraint(char *name, double charge, Tree t) { + + if (con_last==ConstrainSize) + error=TooManyConstrain; + else { + contable[con_last].expr=TreeCreate(); + strcpy(contable[con_last].name, name); + TreeCpy(contable[con_last].expr, t); + contable[con_last].charge=charge; + con_last++; + error=NoError; + } /* else */ +} /* NewConstaint */ + +int NumOfConstraint(void) { + + return con_last; +} /* NumOfConstraint */ + +void GetConstraintNo(int no, char *name, double *charge, Tree t) { + + if (no>con_last) { + error=NotFound; + t=NULL; + } /* if */ + else { + strcpy(name, contable[no-1].name); + *charge=contable[no-1].charge; + error=NoError; + TreeCpy(t, contable[no-1].expr); + } /* else */ +} /* GetConstraintNo */ + +int IsSpecInConstraint(char *name, double charge) { + +/**** + return value : 0 - not found + >0 - constraint number +****/ + + int i, finished, found; + + found=0; + finished=0; + i=0; + + while ((iparam_last) + error=NotFound; + else { + strcpy(name, paramtable[no-1].name); + *charge=paramtable[no-1].charge; + *form=paramtable[no-1].in_use; + error=NoError; + } /* else */ +} /* GetParamNo */ + +int NumOfConstants(void) { + + int i, no; + + no=0; + for(i=0; i0)) { + if (symtable[i].tag==konst) + no--; + i++; + } /* while */ + if (no==0) { + strcpy(name, symtable[i-1].d.k.name); + error=NoError; + } /* if */ + else + error=NotFound; +} /* GetConstantNo */ + +void NewPrintVar(char *name) { + + if (prn_last>=MaxPrint) + error=TooManyPrn; + else { + prntable[prn_last].tag=1; + strcpy(prntable[prn_last].name, name); + prn_last++; + error=NoError; + } /* else */ +} /* NewPrintVar */ + +void NewPrintConc(char *name, double charge) { + + if (prn_last>=MaxPrint) + error=TooManyPrn; + else { + prntable[prn_last].tag=2; + strcpy(prntable[prn_last].name, name); + prntable[prn_last].charge=charge; + prn_last++; + error=NoError; + } /* else */ +} /* NewPrintConc */ + +int NumOfPrint(void) { + + error=NoError; + return prn_last; +} /* NumOfPrint */ + +void GetPrintNo(int no, char *name, double *charge, int *tag) { + + if (no>=prn_last) + error=NotFound; + else { + *tag=prntable[no-1].tag; + strcpy(name, prntable[no-1].name); + *charge=prntable[no-1].charge; /* may give unusable values */ + error=NoError; + } /* else */ +} /* GetPrintNo */ + +int IsSpecInPrnList(char *name, double charge, int tag) { + + /* return 0 is species or dyn. var. should printed */ + + int i; + + i=0; + while (i=StrConstSize) + error=TooManyConst; + else { + strcpy(strtable[str_last].name, name); + strcpy(strtable[str_last].value, value); + str_last++; + error=NoError; + } +} /* NewStrConst */ + +void GetStrConst(char *name, char *value) { + + int i, finished; + + i=0; + finished=0; + while ((istr_last) + error=NotFound; + else { + strcpy(value, strtable[no-1].value); + strcpy(name, strtable[no-1].name); + error=NoError; + } +} /* GetStrConstNo */ + +void NonAutoSystem(void) { + + autonom_system=1; +} /* NonAutoSystem */ + +int IsNonAutoSystem(void) { + + return autonom_system; +} /* IsNonAutoSystem */ + +void GetStocMatrix(int n, int m, double **nu) { + + int i, j, reactno; + double charge, coeff; + char name[STRING_LENGTH]; + + + for(i=0; i +#endif +#include "symbmath.h" + +#define SymSize 250 +#define MaxSpec 150 +#define ReactSize 150 +#define ConstrainSize 50 +#define DynSize 50 +#define ExprSize 50 +#define Conc0Default 0.0 +#define MaxSpecConst 10 +#define MaxParameter 25 +#define MaxPrint 25 +#define StrConstSize 25 +#define MaxDynVarConst 10 + +typedef enum {NoError, TooManyPrn, TooManyConst, TooManySpec, SpecAlready, + KonstAlready, NonSpec, TooManyReact, WrongDirect, ReactAlready, + NotFound, TooManyConstrain, TooManyDynVar, TooManyExpr, + ExprAlready, TooManyParam, ParamAlready} TableErrors; + +typedef struct SpecK { + int used; /* 1=yes, 0=no */ + char name[STRING_LENGTH]; + double value; +} SpecK; + +typedef struct Spec { + char name[STRING_LENGTH]; /* name of species */ + double charge; /* charge */ + double conc0; /* conc. at t=0 */ + int is_param; /* used as parameter */ + SpecK speck[MaxSpecConst]; +} Spec; + + +typedef struct KKonst { + char name[STRING_LENGTH]; /* name of constant */ + double value; /* value */ +} KKonst; + + +typedef enum {spec, konst} SymtabTag; + +typedef union { + KKonst k; + Spec s; +} Data; + +typedef struct SymEntry { + SymtabTag tag; + Data d; +} SymEntry; + +typedef enum {uni, bi, equi} Direc; + +typedef struct SpecCoeff { + char name[STRING_LENGTH]; + double charge; + int in_use; /* 1=in use; 0=not in use */ + double pow_const[2]; /* index=0 <=> reactant, index=1 <=> product */ + double coeff[2]; /* do. */ +} SpecCoeff; + +typedef struct ReactEntry { + int react_no; + SpecCoeff species[MaxSpec]; + Direc react_tag; + int sel1, sel2; /* selx=1 <=> const, selx=2 <=> rate expr */ + Tree t1, t2; +} ReactEntry; /* reaction matrix */ + +typedef struct ConstrainEntry { + char name[STRING_LENGTH]; + double charge; + Tree expr; +} ConstrainEntry; + +typedef struct DynEntry { + char name[STRING_LENGTH]; + SpecK konst[MaxDynVarConst]; +} DynEntry; + +typedef struct ExprEntry { + char name[STRING_LENGTH]; + Tree expr; + double init_value; +} ExprEntry; + +typedef struct ParamEntry { + int in_use; /* 0=no, 1=parameter, 2=concentration */ + char name[STRING_LENGTH]; + double charge; + double init_value; /* initial value */ + double delta; /* increment */ + double low, high, pref; /* other parameters */ + int direct; /* direction for cont. */ +} ParamEntry; + +typedef struct PrnEntry { + int tag; /* 1=name, 2=concentration */ + char name[STRING_LENGTH]; + double charge; +} PrnEntry; + +typedef struct StrEntry { + char name[STRING_LENGTH]; + char value[STRING_LENGTH]; +} StrEntry; + +SymEntry symtable[SymSize]; /* symbol table */ +int sym_last; +ReactEntry reacttable[ReactSize]; /* stoichimetric matrix */ +int react_last; +int current; /* pointer current reaction */ +ConstrainEntry contable[ConstrainSize]; /* constrain table */ +int con_last; +DynEntry dyntable[DynSize]; /* dynamical variables */ +int dyn_last; +TableErrors error; +int search_i, search_j, search_no; /* search vars */ +ExprEntry exprtable[ExprSize]; /* expression table */ +int expr_last; +ParamEntry paramtable[MaxParameter]; +int param_last; +PrnEntry prntable[MaxPrint]; +int prn_last; +StrEntry strtable[StrConstSize]; +int str_last; +int autonom_system; /* 0 if autonomous ODEs, 1 otherwise */ + +extern void SetupTableMan(void); +extern TableErrors GetError(void); +extern void NewSpecie(char *, double); +extern void NewConstant(char *, double); +extern void NewRateConst(int, int, Tree); +extern void NewRateExpr(int, int, Tree); +extern void NewBeginConc(char *, double, double); +extern void SpecieInReaction(int, char *, double); +extern void NewReaction(int); +extern int GetCurrentReaction(void); +extern void AddReactionKind(int, Direc); +extern int GetReactionNo(int); +extern void RenameSpec(char *, char *, double); +extern int NoOfSpec(void); +extern int GetFirstSpecA(int, char *, double *, double *, int); +extern int GetNextSpecA(char *, double *, double *, int); +extern int IsSpecInReact(int, char *, double, double *); +extern int GetFirstSpecB(char *, double *); +extern int GetNextSpecB(char *, double *); +extern double GetCoeffInReact(int, char *, double, int); +extern double GetPowConstInReact(int, char *, double, int); +extern void GetSpecNo(int, char *, double *); +extern Direc GetReactKind(int); +extern void GetRateConst(int, Direc, int, Tree); +extern void GetRateExpr(int, Direc, int, Tree); +extern int NoOfReact(void); +extern void NewCoeff(int, char *, double, double, int); +extern double SumCoeff(int, int); +extern double GetConstant(char *); +extern double GetBeginConc(char *, double); +extern int GetSpecNumber(char *, double); +extern void NewDynVar(char *); +extern int NumOfDynVar(void); +extern void GetDynVarNo(int, char *); +extern void NewExpr(char *, Tree); +extern int NumOfExpr(void); +extern void GetExprNo(int, char *, Tree); +extern int IsVarParameter(char *); +extern void NewPowerConst(int, char *, double, double, int); +extern void NewConstraint(char *, double, Tree); +extern int NumOfConstraint(void); +extern void GetConstraintNo(int, char *, double *, Tree); +extern int IsSpecInConstraint(char *, double); +extern void NewSpecConst(char *, double, char *, double); +extern double GetSpecConst(char *, double, char *); +extern void NewParamter(char *, double); +extern void GetParamNo(int, char *, double *, int *); +extern int NumOfParameter(void); +extern void NewParamConc(char *, double, double); +extern int IsSpecParam(char *, double); +extern void GetConstantNo(int i, char *name); +extern int NumOfConstants(void); +extern void NewDeltaParam(char *, double); +extern void NewDeltaConc(char *, double, double); +extern void GetDeltaParam(char *, double *); +extern void GetDeltaConc(char *, double, double *); +extern void GetInitParam(char *, double *); +extern void GetInitConc(char *, double, double *); +extern void NewPrintVar(char *); +extern void NewPrintConc(char *, double); +extern int NumOfPrint(void); +extern void GetPrintNo(int, char *, double *, int *); +extern int IsSpecInPrnList(char *, double, int); +extern void NewLowHighPrefParam(char *, double, double, double); +extern void GetLowHighPrefParam(char *, double *, double *, double *); +extern void NewLowHighPrefConc(char *, double, double, double, double); +extern void GetLowHighPrefConc(char *, double, double *, double *, + double *); +extern void NewInitValue(char *, double); +extern double GetInitValue(char *); +extern int NoSpecInReacs(char *, double); +extern void NewDirectForParam(char *, int); +extern int GetDirectForParam(char *); +extern void NewDirectForConc(char *, double, int); +extern int GetDirectForConc(char *, double); +extern void NewStrConst(char *, char *); +extern void GetStrConst(char *, char *); +extern int NumOfStrConst(void); +extern void GetStrConstNo(int, char *, char *); +extern void NonAutoSystem(void); +extern int IsNonAutoSystem(void); +extern void NewDynVarConst(char *, char *, double); +extern double GetDynVarConst(char *, char *); +extern void GetStocMatrix(int, int, double **); +#endif diff --git a/src/waves.c b/src/waves.c new file mode 100644 index 0000000..84ba42c --- /dev/null +++ b/src/waves.c @@ -0,0 +1,360 @@ +/************************************************************************* + Waves - a code generator for kc and KGadi/per1d. + This is a full operating generator. + + CopyWrong 1993-1996 by + Kenneth Geisshirt (kneth@fatou.ruc.dk) Keld Nielsen (kn@kin.kiku.dk) + Dept. of Life Sciences and Chemistry Dept. of Theoretical Chemistry + Roskilde University University of Copenhagen + P.O. Box 260 Universitetsparken 5 + 4000 Roskilde 2100 Copenhagen + Denmark Denmark + + Last updated: 17 April 1996 by KG +**************************************************************************/ + +#include +#include +#include +#include +#include "config.h" +#include "symbmath.h" +#include "tableman.h" +#include "codegen.h" +#include "misc.h" + +void AddFullstops(char* str) { + +/* Add fullstops (.) so length(str)=16 */ + + int i; + for(i=strlen(str); i<16; i++) + str=strcat(str, "."); +} /* AddFullstops */ + +void Waves(FILE* code_h, FILE* code_c, FILE* code_ini) { + + double charge, temp, coeff; + char name[STRING_LENGTH], rename[STRING_LENGTH]; + time_t timer; + Tree v_temp, tmp, temp_tree; + int i, j, react_no, finished, constraint, dyn, dyn2; + + timer=time(&timer); + + fprintf(code_h, "/* %s*/\n\n", ctime(&timer)); + fprintf(code_c, "/* %s*/\n\n", ctime(&timer)); + fprintf(code_c, "#include \n"); + fprintf(code_h, "#define n_grids %d\n", (int)GetConstant("ngrid")); + if (GetError()==NotFound) + fprintf(stderr, "ERROR: The constant ngrid is not defined!\n"); + fprintf(code_h, "#define m_grids %d\n", (int)GetConstant("mgrid")); + if (GetError()==NotFound) + fprintf(stderr, "ERROR: The constant mgrid is not defined!\n"); + i=NoOfSpec()+NumOfDynVar()-NumOfConstraint(); /* abuse of i */ + fprintf(code_h, "#define equa %d\n\n", i); + fprintf(code_h, "extern void init_diff_const(void);\n"); + fprintf(code_h, "double D[equa];\n"); + fprintf(code_c, "#include \"model.h\"\n"); + fprintf(code_c, "void init_diff_const(void) {\n"); + dyn=1; + for(i=0; i0) { + fprintf(code_c, " %s=", rename); + TreePrint(con[constraint-1], 3, code_c); + fprintf(code_c, ";\n"); + }; /* if */ + }; /* for i */ + dyn=0; + fprintf(code_c, " switch (l) {\n"); + for(i=1; i<=(NoOfSpec()+NumOfDynVar()-NumOfConstraint()); i++) { + fprintf(code_c, " case %d: return (", i-1); + TreePrint(v[i-1], 3, code_c); + fprintf(code_c, ");\nbreak;\n"); + }; /* for i */ + fprintf(code_c, " } /* switch */\n"); + fprintf(code_c, "} /* reac */\n"); + + /* function eval */ + fprintf(code_h, "extern void eval(double *, double *);\n"); + fprintf(code_c, "void eval(double S[equa], double F[equa]) {\n"); + + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + RenameSpec(rename, name, charge); + fprintf(code_c, " double %s;\n", rename); + }; /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(code_c, " double %s;\n", name); + }; /* for i */ + + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + RenameSpec(rename, name, charge); + constraint=IsSpecInConstraint(name, charge); + if (constraint==0) { + fprintf(code_c, " if (S[%d]<0.0) S[%d]=0.0;\n", dyn-1, dyn-1); + fprintf(code_c, " %s=S[%d];\n", rename, dyn-1); + dyn++; + }; /* if */ + }; /* for i*/ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(code_c, " %s=S[%d];\n", name, i+NoOfSpec()-1); + }; /* for i */ + + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + RenameSpec(rename, name, charge); + constraint=IsSpecInConstraint(name, charge); + if (constraint>0) { + fprintf(code_c, " %s=", rename); + TreePrint(con[constraint-1], 3, code_c); + fprintf(code_c, ";\n"); + }; /* if */ + }; /* for i */ + + dyn=0; + for(i=1; i<=(NoOfSpec()+NumOfDynVar()-NumOfConstraint()); i++) { + fprintf(code_c, " F[%d] = ", i-1); + TreePrint(v[i-1], 3, code_c); + fprintf(code_c, ";\n"); + } /* for i */ + fprintf(code_c, "} /* eval */\n"); + + /* Printing Jacoby matrix */ + fprintf(code_h, "void calc_jac(double S[equa], double tk, double R[equa], double Jac[equa+1][equa+1]);\n"); + fprintf(code_c, "void calc_jac(double S[equa], double tk, double R[equa], double Jac[equa+1][equa+1]) \n{\n"); + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + RenameSpec(rename, name, charge); + fprintf(code_c, " double %s;\n", rename); + }; /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(code_c, " double %s;\n", name); + }; /* for i */ + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + RenameSpec(rename, name, charge); + constraint=IsSpecInConstraint(name, charge); + if (constraint==0) { + fprintf(code_c, " if (S[%d]<0.0) S[%d]=0.0;\n", dyn-1, dyn-1); + fprintf(code_c, " %s=S[%d];\n", rename, dyn-1); + dyn++; + }; /* if */ + }; /* for i*/ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(code_c, " %s=S[%d];\n", name, i+NoOfSpec()-1); + }; /* for i */ + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + RenameSpec(rename, name, charge); + constraint=IsSpecInConstraint(name, charge); + if (constraint>0) { + fprintf(code_c, " %s=", rename); + TreePrint(con[constraint-1], 3, code_c); + fprintf(code_c, ";\n"); + }; /* if */ + }; /* for i */ + for(i=0; i0) { + fprintf(code_c, " %s=", rename); + TreePrint(con[constraint-1], 3, code_c); + fprintf(code_c, ";\n"); + }; /* if */ + }; /* for i */ + fprintf(code_c, "switch (l) {\n"); + for(i=1; i<=NoOfSpec()-NumOfConstraint()+NumOfDynVar(); i++) { + fprintf(code_c, "case %d:\n", i); + fprintf(code_c, "return (tk*("); + TreePrint(v[i-1], 3, code_c); + fprintf(code_c, ")-S[%d]*(1+4*R[%d])+K[%d]);\nbreak;\n", i-1, i-1, i-1); + } /* for i */ + fprintf(code_c, "}\n}\n"); + + /* Printing Jacobi matrix (the right one) */ + fprintf(code_h, "void calc_jac2(double S[equa], double Jac[equa][equa]);\n"); + fprintf(code_c, "void calc_jac2(double S[equa], double Jac[equa][equa]) \n{\n"); + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + RenameSpec(rename, name, charge); + fprintf(code_c, "double %s;\n", rename); + }; /* for i */ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(code_c, "double %s;\n", name); + }; /* for i */ + dyn=1; + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + RenameSpec(rename, name, charge); + constraint=IsSpecInConstraint(name, charge); + if (constraint==0) { + fprintf(code_c, "%s=S[%d];\n", rename, dyn-1); + dyn++; + }; /* if */ + }; /* for i*/ + for(i=1; i<=NumOfDynVar(); i++) { + GetDynVarNo(i, name); + fprintf(code_c, "%s=S[%d];\n", name, i+NoOfSpec()-1); + }; /* for i */ + for(i=1; i<=NoOfSpec(); i++) { + GetSpecNo(i, name, &charge); + RenameSpec(rename, name, charge); + RenameSpec(rename, name, charge); + constraint=IsSpecInConstraint(name, charge); + if (constraint>0) { + fprintf(code_c, " %s=", rename); + TreePrint(con[constraint-1], 3, code_c); + fprintf(code_c, ";\n"); + }; /* if */ + }; /* for i */ + for(i=0; i +#include +#include "symbmath.h" +#include "tableman.h" +#include "codecall.h" + +typedef enum {no, ini, ord} Conc; + +typedef struct compound { + char name[STRING_LENGTH]; + double charge; + Conc concs; +} compound; + +typedef struct Strnum { + int flag; + char name[STRING_LENGTH]; + double numb; +} Strnum; + +double coeff, charge, value, temp, temp1, temp2; +char flag, name[STRING_LENGTH], string[STRING_LENGTH]; +int i, j, side, lineno=1; +Tree tmp; diff --git a/test/A1.des b/test/A1.des new file mode 100644 index 0000000..fb26385 --- /dev/null +++ b/test/A1.des @@ -0,0 +1,14 @@ +method = 4; + +htime = 0.01; +etime = 20; + +y1' = -0.5*y1; +y2' = -y2; +y3' = -100.0*y3; +y4' = -90.0*y4; + +y1(0) = 1.0; +y2(0) = 1.0; +y3(0) = 1.0; +y4(0) = 1.0; diff --git a/test/A2.des b/test/A2.des new file mode 100644 index 0000000..8e392da --- /dev/null +++ b/test/A2.des @@ -0,0 +1,24 @@ +method = 4; + +htime = 5.0e-4; +etime = 120; + +y1' = -1800*y1 + 900*y2; +y2' = y1 - 2*y2 + y3; +y3' = y2 - 2*y3 + y4; +y4' = y3 - 2*y4 + y5; +y5' = y4 - 2*y5 + y6; +y6' = y5 - 2*y6 + y7; +y7' = y6 - 2*y7 + y8; +y8' = y7 - 2*y8 + y9; +y9' = 1000*y8 - 2000*y9 + 1000; + +y1(0) = 0; +y2(0) = 0; +y3(0) = 0; +y4(0) = 0; +y5(0) = 0; +y6(0) = 0; +y7(0) = 0; +y8(0) = 0; +y9(0) = 0; diff --git a/test/A3.des b/test/A3.des new file mode 100644 index 0000000..f84fe3a --- /dev/null +++ b/test/A3.des @@ -0,0 +1,14 @@ +method = 4; + +etime = 20; +htime = 1.0e-5; + +y1' = -10000*y1 + 100*y2 - 10*y3 + y4; +y2' = -1000*y2 + 10*y3 - 10*y4; +y3' = -y3 + 10*y4; +y4' = -0.1*y4; + +y1(0) = 1; +y2(0) = 1; +y3(0) = 1; +y4(0) = 1; diff --git a/test/A4.des b/test/A4.des new file mode 100644 index 0000000..7efbbb2 --- /dev/null +++ b/test/A4.des @@ -0,0 +1,26 @@ +method = 4; + +htime = 1.0e-5; +etime = 1.0; + +y1' = -1^5*y1; +y2' = -2^5*y2; +y3' = -3^5*y3; +y4' = -4^5*y4; +y5' = -5^5*y5; +y6' = -6^5*y6; +y7' = -7^5*y7; +y8' = -8^5*y8; +y9' = -9^5*y9; +y10' = -10^5*y10; + +y1(0) = 1.0; +y2(0) = 1.0; +y3(0) = 1.0; +y4(0) = 1.0; +y5(0) = 1.0; +y6(0) = 1.0; +y7(0) = 1.0; +y8(0) = 1.0; +y9(0) = 1.0; +y10(0) = 1.0; diff --git a/test/B1.des b/test/B1.des new file mode 100644 index 0000000..77b8411 --- /dev/null +++ b/test/B1.des @@ -0,0 +1,14 @@ +method = 4; + +etime = 20; +htime = 7.0e-3; + +y1' = -y1 + y2; +y2' = -100*y1 - y2; +y3' = -100*y3 + y4; +y4' = -10000*y3 - 100*y4; + +y1(0) = 1.0; +y2(0) = 0.0; +y3(0) = 1.0; +y4(0) = 0.0; diff --git a/test/B2-5.des b/test/B2-5.des new file mode 100644 index 0000000..eb0d39b --- /dev/null +++ b/test/B2-5.des @@ -0,0 +1,24 @@ +method = 4; + +alpha = 100; + +etime = 20.0; +htime = 0.01; + +y1' = -10*y1 + alpha*y2; +y2' = -alpha*y1 - 10*y2; +y3' = -4*y3; +y4' = -y4; +y5' = -0.5*y5; +y6' = -0.1*y6; + +y1(0) = 1.0; +y2(0) = 1.0; +y3(0) = 1.0; +y4(0) = 1.0; +y5(0) = 1.0; +y6(0) = 1.0; +y7(0) = 1.0; +y8(0) = 1.0; +y9(0) = 1.0; +y10(0) = 1.0; diff --git a/test/C1.des b/test/C1.des new file mode 100644 index 0000000..a1560d1 --- /dev/null +++ b/test/C1.des @@ -0,0 +1,14 @@ +method = 4; + +etime = 20.0; +htime = 0.01; + +y1' = -y1 + y2^2 + y3^2 + y4^2; +y2' = -10*y2 + 10*(y3^2+y4^2); +y3' = -40*y3 + 40*y4^2; +y4' = -100*y4 + 2; + +y1(0) = 1.0; +y2(0) = 1.0; +y3(0) = 1.0; +y4(0) = 1.0; diff --git a/test/C2-5.des b/test/C2-5.des new file mode 100644 index 0000000..a6a50f9 --- /dev/null +++ b/test/C2-5.des @@ -0,0 +1,16 @@ +method = 4; + +beta = 20.0; + +etime = 20.0; +htime = 0.01; + +y1' = -y1 + 2; +y2' = -10*y2 + beta*y1^2; +y3' = -40*y3 + 4*beta*(y1^2 + y2^2); +y4' = -100*y4 + 10*beta*(y1^2 + y2^2 + y3^2); + +y1(0) = 1.0; +y2(0) = 1.0; +y3(0) = 1.0; +y4(0) = 1.0; diff --git a/test/D1.des b/test/D1.des new file mode 100644 index 0000000..d9e3a5c --- /dev/null +++ b/test/D1.des @@ -0,0 +1,12 @@ +method = 4; + +etime = 400.0; +htime = 1.7e-2; + +y1' = 0.2*(y2 - y1); +y2' = 10*y1 - (60 - 0.125*y3)*y2 + 0.125*y3; +y3' = 1.0; + +y1(0) = 0; +y2(0) = 0; +y3(0) = 0; diff --git a/test/D3.des b/test/D3.des new file mode 100644 index 0000000..042f252 --- /dev/null +++ b/test/D3.des @@ -0,0 +1,14 @@ +method = 4; + +etime = 20; +htime = 2.5e-5; + +y1' = y3 - 100*y1*y2; +y2' = y3 + 2*y4 - 100*y1*y2 -2.0e4*y2^2; +y3' = -y3 + 100*y1*y2; +y4' = -y4 + 1.0e4*y2^2; + +y1(0) = 1.0; +y2(0) = 1.0; +y3(0) = 0.0; +y4(0) = 0.0; diff --git a/test/D4.des b/test/D4.des new file mode 100644 index 0000000..b46eaa4 --- /dev/null +++ b/test/D4.des @@ -0,0 +1,12 @@ +method = 4; + +etime = 50; +htime = 2.9e-4; + +y1' = -0.013*y1 - 1000*y1*y2; +y2' = -2500*y2*y3; +y3' = -0.013*y1 - 1000*y1*y3 - 2500*y2*y3; + +y1(0) = 1.0; +y2(0) = 1.0; +y3(0) = 0.0; diff --git a/test/D5.des b/test/D5.des new file mode 100644 index 0000000..f7442ee --- /dev/null +++ b/test/D5.des @@ -0,0 +1,10 @@ +method = 4; + +etime = 100; +htime = 1.0e-4; + +y1' = 0.01 - (1 + (y1 + 1000)*(y1 + 1))*(0.01 + y1 + y2); +y2' = 0.01 - (1 + y2^2)*(0.01 + y1 + y2); + +y1(0) = 0.0; +y2(0) = 0.0; diff --git a/test/D6.des b/test/D6.des new file mode 100644 index 0000000..e8852f4 --- /dev/null +++ b/test/D6.des @@ -0,0 +1,12 @@ +method = 2; + +etime = 1.0; +htime = 3.3e-8; + +y1' = -y1 + 1.0e8*y3*(1 - y1); +y2' = -10*y2 + 3.0e7*y3*(1 - y2); +y3' = -(-y1 + 1.0e8*y3*(1 - y1)) - (-10*y2 + 3.0e7*y3*(1 - y2)); + +y1(0) = 1; +y2(0) = 0; +y3(0) = 0; diff --git a/test/E1.des b/test/E1.des new file mode 100644 index 0000000..823bebf --- /dev/null +++ b/test/E1.des @@ -0,0 +1,16 @@ +etime = 1; +htime = 6.8e-3; + +Gamma = 100; + +y1' = y2; +y2' = y3; +y3' = y4; +y4' = (y1^2 - sin(y1) - Gamma^4)*y1 + + (y2*y3/(y1^2 + 1) - 4*Gamma^3)*y2 + + (1 - 6*Gamma^2)*y3 + (10*exp(-y4^2) - 4*Gamma)*y4 + 1; + +y1(0) = 0.0; +y2(0) = 0.0; +y3(0) = 0.0; +y4(0) = 0.0; \ No newline at end of file diff --git a/test/E2.des b/test/E2.des new file mode 100644 index 0000000..69aaacd --- /dev/null +++ b/test/E2.des @@ -0,0 +1,8 @@ +etime = 1; +htime = 1.0e-3; + +y1' = y2; +y2' = 5*(1 - y1^2)*y2 - y1; + +y1(0) = 2; +y2(0) = 0; \ No newline at end of file diff --git a/test/E3.des b/test/E3.des new file mode 100644 index 0000000..6f00801 --- /dev/null +++ b/test/E3.des @@ -0,0 +1,10 @@ +etime = 500; +htime = 0.02; + +y1' = -(55 + y3)*y1 + 65*y2; +y2' = 0.0785*(y1 - y2); +y3' = 0.1*y1; + +y1(0) = 1; +y2(0) = 1; +y3(0) = 0; \ No newline at end of file diff --git a/test/E5.des b/test/E5.des new file mode 100644 index 0000000..4963672 --- /dev/null +++ b/test/E5.des @@ -0,0 +1,12 @@ +etime = 1000; +htime = 5.0e-5; + +y1' = -7.89e-10*y1 - 1.1e7*y1*y2; +y2' = 7.89e-10*y1 - 1.13e9*y2*y3; +y3' = 7.89e-10*y1 - 1.1e7*y1*y3 + 1.13e3*y4 - 1.13e9*y2*y3; +y4' = 1.1e7*y1*y3 - 1.13e3*y4; + +y1(0) = 1.76e-3; +y2(0) = 0; +y3(0) = 0; +y4(0) = 0; \ No newline at end of file diff --git a/test/F1.des b/test/F1.des new file mode 100644 index 0000000..3df2154 --- /dev/null +++ b/test/F1.des @@ -0,0 +1,10 @@ +method = 1; + + +htime = 1.0e-4; +etime = 1000; + +y1' = 1.3*(y3-y1) + 10400*exp(20.7-1500/y1)*y2; +y2' = 1880*(y4-y2*(1+exp(20.7-1500/y1))); +y3' = 1752 - 269*y3 + 267*y1; +y4' = 0.1 + 320*y2 - 321*y4; diff --git a/test/H2O2.des b/test/H2O2.des new file mode 100644 index 0000000..5b71110 --- /dev/null +++ b/test/H2O2.des @@ -0,0 +1,40 @@ +/* P. Gray et al. in Complex chemical reaction systems, p. 150, Springer, 1987 */ + +etime = 1.0; +dtime = 0.01; +prnmode = 1; + +T = 1000; + +k1 = 1.00e8*exp(-24200/T); +k2 = 1.95e7*exp(-2850/T); +k3 = 1.15e8*exp(-7919/T); +k4 = 6.56e7*exp(-5337/T); +k5 = 6.00e3*exp(605/T); +k6 = 3.00e8*exp(-2000/T); +k7 = 1.50e8*exp(-506/T); +k8 = 1.03e3; +k9 = 3.38e4; + +k10= 3.10e7*exp(-28700/T); +k11= 6.50e5*exp(-9440/T); + +1: H2 + O2 -> 2 OH; k>=k1; +2: OH + H2 -> H2O + H; k>=k2; +3: H + O2 -> OH + O; k>=k3; +4: O + H2 -> OH + H; k>=k4; +5: H + O2 + Ar -> HO2 + Ar; k>=k5; +6: HO2 + H -> H2O + O; k>=k6; +7: HO2 + H -> 2OH; k>=k7; +8: 2H + Ar -> H2 + Ar; k>=k8; +9: H + OH + Ar -> H2O + Ar; k>=k9; + +/* +10: H2 + O2 -> HO2 + H; k>=k10; +11: HO2 + H2 -> H2O + OH; k>=k11; +*/ + +[Ar](0) = 0.1; +[O2](0) = 5.0e-3; +[H2](0) = 0.01; +[H](0) = 1.0e-10; \ No newline at end of file diff --git a/test/anita.des b/test/anita.des new file mode 100644 index 0000000..d81900f --- /dev/null +++ b/test/anita.des @@ -0,0 +1,38 @@ +/* ODE from Anita Kildebaek Nielsen. */ + + +method = 3; /* which integration scheme */ +prnmode = 2; + +am = 4.6263e5; +ZETA = 1.0; + +etime=15000.0; /* end time */ +dtime=1; /* interval between output */ + +epsa = 1.0e-10; /* absolute tolerence */ +epsr = 1.0e-8; /* relative tolerence */ + +datafile = "anitaout"; /* output file */ + +a1' = a2/am; +b1' = b2/am; + +a2' = ZETA*(exp(-ZETA*a1)*cos(ZETA*b1)); +b2' = -ZETA*exp(-ZETA*a1)*sin(ZETA*b1); + +a3' = (-2/am)*(a3^2-b3^2) - 0.5*ZETA^2*exp(-ZETA*a1)*cos(ZETA*b1); +b3' = (-4/am)*a3*b3 + 0.5*ZETA^2*exp(-ZETA*a1)*sin(ZETA*b1); + +a4' = -b3/am + (a2^2-b2^2)/(2*am) - exp(-ZETA*a1)*cos(ZETA*b1); +b4' = a3/am + a2*b2/am + exp(-ZETA*a1)*sin(ZETA*b1); + + +a1(0)=5.02646; +b1(0)=0.0; +a2(0)=1000; +b2(0)=0.0; +a3(0)=0.01; +b3(0)=0.01; +a4(0)=0.0; +b4(0)=1.17754482525; diff --git a/test/atmos1.des b/test/atmos1.des new file mode 100644 index 0000000..bd4f855 --- /dev/null +++ b/test/atmos1.des @@ -0,0 +1,29 @@ +/* Atmospheric model. */ +/* Dansk Kemi 6/7, pp. 18-21, 1994 */ + +/* Rate constants */ + +k4 = 5.0e-11; +k8 = 1.68e-11; + + + +/* The reactions */ + +1: F + CF3H -> CF3 + HF; k>=1.3e-13; +2: O2 + M -> FO2 + M; k>=2.0e-13; +3: F + NO + M -> FNO + M; k>=6.0e-12; +4: CF3 + O2 + M -> CF3O2 + M; k>=8.5e-12; +5: CF3 + NO + M -> CF3NO + M; k>=1.8e-11; +6: CF3 + NO2 + M -> Prod; k>=2.5e-11; +7: CF3O2 + NO -> CF3O + NO2; k>=k4; +8: CF3O2 + NO2 -> CF3O2NO2; k>=8.0e-12; +9: 2 CF3O2 -> 2 CF3O + O2; k>=1.8e-12; +10: CF3O + NO2 -> CF3ONO2; k>=9.0e-12; +11: CF3O + CF3O2 -> CF3O3CF3; k>=2.5e-11; +12: 2 CF3O -> CF3O2CF3; k>=2.5e-11; +13: CF3O + NO -> CF2O + FNO; k>=k8; + + +[NO](0) = 2.5e+8; +[NO2](0) = 2.5e+8; diff --git a/test/burst-2par.des b/test/burst-2par.des new file mode 100644 index 0000000..381fc0f --- /dev/null +++ b/test/burst-2par.des @@ -0,0 +1,63 @@ +/* Belousov - Zhabotinsky reaction, Burst generation */ +/* k = 2.9; g = 0.42; kf6 = k*g; kf7 = k * ( 1 - g ) ; */ +/* Reduceret model, KN 27.9 1994 */ + +dtime = 10.00; +etime = 20000.0; +htime = 0.005; +epsr = 1.0E-4; +epsa = 1.0E-20; + + +prnmode = 0; +method = 4; +stepadjust = 0.9; +maxinc = 1.5; +mindec = 0.5; +htimemin = 1.0E-20; +datafile = "burstdat1"; + + +/* Parameters */ +/* +j0 = 8.500000L-05; +kf6= 8.2; +*/ +C0 = 0.86L-4; + +#parameter j0 = 0.85E-04, 0.0, 1.0, 1.0E-8, 0.000001, 1.0; +#parameter kf6 = 8.2, 0.0, 100.0, 1.0E-2, 0.0001, -1.0; + +/* Flow terms */ +101: HBrO2 -> P ; k> = j0; +102: Br(-) -> P ; k> = j0; +103: CeIV -> P ; k> = j0; +104: HBrO -> P ; k> = j0; +105: BrO2 -> P ; k> = j0; +106: BrMA -> P ; k> = j0; + + +1: BrO3(-) + Br(-) + 2H(+) -> HBrO2 + HBrO ; k> = 2.0; +2: HBrO2 + Br(-) + H(+) -> 2HBrO ; k> = 2.0L6; +3: BrO3(-) + HBrO2 + H(+) <=> 2BrO2 + H2O ; k> = 33.0; k< = 7.0L5; +4: BrO2 + CeIII + H(+) <=> HBrO2 + CeIV ; k> = 6.2L4;k< = 7.0L3; +5: 2HBrO2 -> HBrO + BrO3(-) + H(+) ; k> = 3.0L3; +6: HBrO + MA -> BrMA + H2O ; k> = kf6; +7: CeIV + MA -> CeIII + P ; k> = 0.3; +8: CeIV + BrMA -> Br(-) + CeIII ; k> = 30.0; + +[BrO3(-)] = 0.012; +[MA] = 0.167; +[H(+)] = 1.0; +[H2O] = 55.5; +[P] = 0.0; + +[CeIII] = C0 - [CeIV]; + + +[HBrO2](0) = 4.153821e-08; +[Br(-)](0) = 3.217686e-07; +[CeIV](0) = 7.906439e-07; +[HBrO](0) = 2.281131e-08; +[BrO2](0) = 5.854012e-09; +[BrMA](0) = 1.696279e-03; diff --git a/test/burst.des b/test/burst.des new file mode 100644 index 0000000..81058c2 --- /dev/null +++ b/test/burst.des @@ -0,0 +1,64 @@ +/* Belousov - Zhabotinsky reaction, Burst generation */ +/* k = 2.9; g = 0.42; kf6 = k*g; kf7 = k * ( 1 - g ) ; */ +/* Reduceret model, KN 27.9 1994 */ + +dtime = 10.00; +etime = 20000.0; +htime = 0.005; +epsr = 1.0E-4; +epsa = 1.0E-20; + + +prnmode = 0; +method = 4; +stepadjust = 0.9; +maxinc = 1.5; +mindec = 0.5; +htimemin = 1.0E-20; +datafile = "burstdat1"; +ref= 3; + + +/* Parameters */ +/* +j0 = 8.500000L-05; +kf6= 8.2; +*/ +C0 = 0.86L-4; + +#parameter j0 = 0.85E-04, 0.0, 1.0, 1.0E-8, 0.000001, 1.0; +#parameter kf6 = 8.2, 0.0, 100.0, 1.0E-2, 0.0001, -1.0; + +/* Flow terms */ +101: HBrO2 -> P ; k> = j0; +102: Br(-) -> P ; k> = j0; +103: CeIV -> P ; k> = j0; +104: HBrO -> P ; k> = j0; +105: BrO2 -> P ; k> = j0; +106: BrMA -> P ; k> = j0; + + +1: BrO3(-) + Br(-) + 2H(+) -> HBrO2 + HBrO ; k> = 2.0; +2: HBrO2 + Br(-) + H(+) -> 2HBrO ; k> = 2.0L6; +3: BrO3(-) + HBrO2 + H(+) <=> 2BrO2 + H2O ; k> = 33.0; k< = 7.0L5; +4: BrO2 + CeIII + H(+) <=> HBrO2 + CeIV ; k> = 6.2L4;k< = 7.0L3; +5: 2HBrO2 -> HBrO + BrO3(-) + H(+) ; k> = 3.0L3; +6: HBrO + MA -> BrMA + H2O ; k> = kf6; +7: CeIV + MA -> CeIII + P ; k> = 0.3; +8: CeIV + BrMA -> Br(-) + CeIII ; k> = 30.0; + +[BrO3(-)] = 0.012; +[MA] = 0.167; +[H(+)] = 1.0; +[H2O] = 55.5; +[P] = 0.0; + +[CeIII] = C0 - [CeIV]; + + +[HBrO2](0) = 4.153821e-08; +[Br(-)](0) = 3.217686e-07; +[CeIV](0) = 7.906439e-07; +[HBrO](0) = 2.281131e-08; +[BrO2](0) = 5.854012e-09; +[BrMA](0) = 1.696279e-03; diff --git a/test/burst.kcd b/test/burst.kcd new file mode 100644 index 0000000..0496b7e --- /dev/null +++ b/test/burst.kcd @@ -0,0 +1,50 @@ +/* Belousov - Zhabotinsky reaction, Burst generation */ +/* k = 2.9; g = 0.42; kf6 = k*g; kf7 = k * ( 1 - g ) ; */ + +/* Integration parameters */ + +method=1; + +stime = 0; +dtime = 1; +etime = 1500; + +/* reaction parameters */ + +j0= 0.85e-04; + +/* Flow reactions */ + +1: HBrO2 -> P ; k> = j0; +2: Br(-) -> P ; k> = j0; +3: CeIV -> P ; k> = j0; +4: HBrO -> P ; k> = j0; +5: BrO2 -> P ; k> = j0; +6: BrMA -> P ; k> = j0; + +/* Chemical Reactions */ + +10: BrO3(-) + Br(-) + 2H(+) <-> HBrO2 + HBrO ; k> = 2.0; k< = 3.3; +20: HBrO2 + Br(-) + H(+) <-> 2HBrO ; k> = 2.0e6; k< = 2.5e-5; +30: BrO3(-) + HBrO2 + H(+) <-> 2BrO2 + H2O ; k> = 33; k< = 7.0e5; +40: BrO2 + CeIII + H(+) <-> HBrO2 + CeIV ; k> = 6.2e4; k< = 7.0e3; +50: 2HBrO2 <-> HBrO + BrO3(-) + H(+); k> = 3.0e3; k< = 7.5e-9; +60: HBrO + MA -> BrMA + H2O ; k> = 16.4; +70: CeIV + MA -> CeIII + P ; k> = 0.3; +80: CeIV + BrMA -> Br(-) + CeIII ; k> = 30; +90: CeIV + BrMA -> P ; k> = 0; + +[BrO3(-)] = 0.012; +[MA] = 0.167; +[H(+)] = 1.0; +[H2O] = 55.5; +[P] = 0; +[CeIII] = 0.86e-4 - [CeIV]; + +[HBrO2](0) = 0.963349e-09; +[Br(-)](0) = 0.706836e-06; +[CeIV](0) = 0.512017e-06; +[HBrO](0) = 0; +[BrO2](0) = 0.332516e-07; +[BrMA](0) = 0; + diff --git a/test/burst3.13 b/test/burst3.13 new file mode 100644 index 0000000..52529c8 --- /dev/null +++ b/test/burst3.13 @@ -0,0 +1,56 @@ +/* Belousov - Zhabotinsky reaction, Burst generation */ +/* k = 2.9; g = 0.42; kf6 = k*g; kf7 = k * ( 1 - g ) ; */ +/* Reduceret model, KN 27.9 1994 */ + +dtime = 10.00; +etime = 500000.0; +htime = 0.005; +epsr = 1.0E-4; +epsa = 1.0E-20; + +prnmode = 0; +method = 1; +stepadjust = 0.9; +maxinc = 1.5; +mindec = 0.5; +htimemin = 1.0E-20; +datafile = "burstdat13"; + + +/* Parameters */ +j0 = 9.000000L-05; +C0 = 0.86L-4; + + +/* Flow terms */ +101: HBrO2 -> P ; k> = j0; +102: Br(-) -> P ; k> = j0; +103: CeIV -> P ; k> = j0; +104: HBrO -> P ; k> = j0; +105: BrO2 -> P ; k> = j0; +106: BrMA -> P ; k> = j0; + + +1: BrO3(-) + Br(-) + 2H(+) -> HBrO2 + HBrO ; k> = 2.0; +2: HBrO2 + Br(-) + H(+) -> 2HBrO ; k> = 2.0L6; +3: BrO3(-) + HBrO2 + H(+) <=> 2BrO2 + H2O ; k> = 33.0; k< = 7.0L5; +4: BrO2 + CeIII + H(+) <=> HBrO2 + CeIV ; k> = 6.2L4;k< = 7.0L3; +5: 2HBrO2 -> HBrO + BrO3(-) + H(+) ; k> = 3.0L3; +6: HBrO + MA -> BrMA + H2O ; k> = 8.2; +7: CeIV + MA -> CeIII + P ; k> = 0.3; +8: CeIV + BrMA -> Br(-) + CeIII ; k> = 30.0; + +[BrO3(-)] = 0.012; +[MA] = 0.167; +[H(+)] = 1.0; +[H2O] = 55.5; +[P] = 0.0; + +[CeIII] = C0 - [CeIV]; + +[HBrO2](0) = 4.153821e-08; +[Br(-)](0) = 3.217686e-07; +[CeIV](0) = 7.906439e-07; +[HBrO](0) = 2.281131e-08; +[BrO2](0) = 5.854012e-09; +[BrMA](0) = 1.696279e-03; diff --git a/test/burst3.des b/test/burst3.des new file mode 100644 index 0000000..46836af --- /dev/null +++ b/test/burst3.des @@ -0,0 +1,62 @@ +/* Belousov - Zhabotinsky reaction, Burst generation */ +/* k = 2.9; g = 0.42; kf6 = k*g; kf7 = k * ( 1 - g ) ; */ +/* Reduceret model, KN 27.9 1994 */ + +dtime = 10.00; +etime = 20000.0; +htime = 0.005; +epsr = 1.0E-4; +epsa = 1.0E-20; + + +prnmode = 0; +method = 4; +stepadjust = 0.9; +maxinc = 1.5; +mindec = 0.5; +htimemin = 1.0E-20; +datafile = "burstdat1"; + + +/* Parameters */ +/*j0 = 8.500000L-05;*/ +C0 = 0.86L-4; + + +#parameter j0 = 0.85E-04, 0.0, 1.0, 1.0E-8, 0.000001, 1.0; +#parameter C0 = 0.86E-04, 0.0, 1.0, 1.0E-8, 0.000001, 1.0; + + +/* Flow terms */ +101: HBrO2 -> P ; k> = j0; +102: Br(-) -> P ; k> = j0; +103: CeIV -> P ; k> = j0; +104: HBrO -> P ; k> = j0; +105: BrO2 -> P ; k> = j0; +106: BrMA -> P ; k> = j0; + + +1: BrO3(-) + Br(-) + 2H(+) -> HBrO2 + HBrO ; k> = 2.0; +2: HBrO2 + Br(-) + H(+) -> 2HBrO ; k> = 2.0L6; +3: BrO3(-) + HBrO2 + H(+) <=> 2BrO2 + H2O ; k> = 33.0; k< = 7.0L5; +4: BrO2 + CeIII + H(+) <=> HBrO2 + CeIV ; k> = 6.2L4;k< = 7.0L3; +5: 2HBrO2 -> HBrO + BrO3(-) + H(+) ; k> = 3.0L3; +6: HBrO + MA -> BrMA + H2O ; k> = 8.2; +7: CeIV + MA -> CeIII + P ; k> = 0.3; +8: CeIV + BrMA -> Br(-) + CeIII ; k> = 30.0; + +[BrO3(-)] = 0.012; +[MA] = 0.167; +[H(+)] = 1.0; +[H2O] = 55.5; +[P] = 0.0; + +[CeIII] = C0 - [CeIV]; + + +[HBrO2](0) = 4.153821e-08; +[Br(-)](0) = 3.217686e-07; +[CeIV](0) = 7.906439e-07; +[HBrO](0) = 2.281131e-08; +[BrO2](0) = 5.854012e-09; +[BrMA](0) = 1.696279e-03; diff --git a/test/dimitri.des b/test/dimitri.des new file mode 100644 index 0000000..822e5df --- /dev/null +++ b/test/dimitri.des @@ -0,0 +1,4 @@ +1: S1 + S2 -> S3; k>=1.1; +2: S1 + 2S3 -> S4; k>=2.3; + +[S1](0)=0.0; diff --git a/test/enzyme1.des b/test/enzyme1.des new file mode 100644 index 0000000..415e296 --- /dev/null +++ b/test/enzyme1.des @@ -0,0 +1,22 @@ +/* Michaelis-Menten */ + +E0 = 1.0e-5; + +k1 = 1.0e4; +k1m = 100.0; +k2 = 100.0; +KM = (k1m+k2)/k1; + + +1: E + S <-> ES; k>=k1; k<=k1m; +2: ES -> P + E; k>=k2; + +3: S2 -> P2; v>=k2*[S2]*E0/(KM+[S]); + +[E](0) = E0; +[S](0) = 1.0e-3; +[ES](0) = 0.0; +[P](0) = 0.0; + +[S2](0) = 1.0e-3; +[P2](0) = 0.0; \ No newline at end of file diff --git a/test/enzyme2.des b/test/enzyme2.des new file mode 100644 index 0000000..38b4268 --- /dev/null +++ b/test/enzyme2.des @@ -0,0 +1,11 @@ +/* trypsin */ + +etime = 15000.0; +dtime = 10.0; + +1: E + S <-> ES; k>=1.0e4; k<=100.0; +2: ES -> EP + P1; k>=50.0; +3: EP -> E + P2; k>=0.1; + +[E](0) = 1.0e-6; +[S](0) = 1.0e-3; \ No newline at end of file diff --git a/test/ex1.des b/test/ex1.des new file mode 100644 index 0000000..1afabaf --- /dev/null +++ b/test/ex1.des @@ -0,0 +1,43 @@ +/* Dette er en kommentar */ +(* og det er dette ogsaa *) + + +etime = 10.0; /* slut tid */ +dtime = 0.01; /* print interval */ + +debug = 0; /* slaa test-udskrifter fra */ +prnmode = 1; /* hvordan printes, 1=normal */ + +epsr = 1.0e-10; /* nojagtighed, relativ */ +epsa = 1.0e-10; /* nojagtighed, absolut */ + +method = 1; /* losningsmetode */ + + +/* hvad skal printes */ +datafile = "minedata"; +#print [H2], [H(+)]; + +/* bruger-konstanter: */ +A1 = 1.2e20; +E1 = 70; + +R = 8.314; + +Ctotal = 5.0; + + +/* reaktionerne: */ +1: H2 + 2 O2 -> 2 H2O; v>=A*exp(-E1/(R*T))*[H2]*[O2]^2; +2: H(+) + SO4(-2) <-> HSO4(-); k>=2.0; k<=3.0; +T' = ...; + +/* stokiometrisk baand: */ +[H(+)] = Ctotal - [SO4(-2)] - [HSO4(-)]; + + +/* begyndelseskonc. */ +[H2](0) = 1.0; +[O2](0) = 1.2; +T(0) = 273; + diff --git a/test/farrow.des b/test/farrow.des new file mode 100644 index 0000000..3b30463 --- /dev/null +++ b/test/farrow.des @@ -0,0 +1,96 @@ +/**************************************************************************** + The following model is from a paper by Farrow and Edelson: + Int. J. Chem. Kin., vol. 6, pp. 787-800 (1974). +*****************************************************************************/ + +etime = 200; +dtime = 0.1; + +#print [NO], [NO2], [O3], [C3H6]; + +1: NO2 -> NO + O; k>=0.37; +2: O + O2 -> O3; k>=22; +3: O3 + NO -> NO2 + O2; k>=22.5; +4: O3 + NO2 -> NO3 + O2; k>=0.049; +5: NO3 + NO2 -> N2O5; k>=858; +6: N2O5 -> NO3 + NO2; k>=2.76; +7: N2O5 + H2O -> 2HNO3; k>=0.75; +8: NO3 + NO2 -> NO + O2 + NO2; k>=0.49; +9: O + NO2 -> O2 + NO; k>=5150; +10: NO3 + NO -> 2NO2; k>=1.4e+5; +11: NO + NO2 + H2O -> 2HNO2; k>=1.0e-3; +12: HNO2 -> NO + OH(.); k>=1.0e-2; +14: CO + OH(.) + O2 -> CO2 + HO2(.); k>=9.8e-4; +15: HO2(.) + NO -> NO2 + OH(.); k>=30; +16: HO2(.) + NO2 -> HNO2 + O2; k>=1.0e-3; +17: OH(.) + NO2 -> HNO3; k>=1470; +18: OH(.) + NO -> HNO2; k>=1.0e+4; +19: 2HO2(.) -> H2O2 + O2; k>=70; +20: C3H6 + O -> CH3CH2(.) + CHO(.); k>=2925; +21: C3H6 + O -> CH3(.) + CH3CO(.); k>=500; +22: C3H6 + O + O2 -> C2H4O2 + HCHO; k>=1.25e-3; +23: C3H6 + O3 -> C2H4O2 + HCHO; k>=7.0e-3; +24: C3H6 + O3 -> CH3CHO + CH2O2; k>=7.0e-3; +25: C2H4O2 -> CH3O(.) + CHO(.); k>=0.3; +26: C2H4O2 + NO -> CH3CHO + NO2; k>=3; +27: C2H4O2 + NO2 -> CH3CHO + NO3; k>=0.1; +28: CH2O2 -> OH(.) + CHO(.); k>=0.3; +29: CH2O2 + NO -> HCHO + NO2; k>=3; +30: CH2O2 + NO2 -> HCHO + NO3; k>=0.1; +31: CH3(.) + O2 -> CH3O2(.); k>=15; +32: CH3O2(.) + NO -> CH3O(.) + NO2; k>=6; +33: CH3O(.) + O2 -> HCHO + HO2(.); k>=0.26; +34: CH3O(.) + NO2 -> CH3NO3; k>=16.2; +35: CH3CH2(.) + O2 -> CH3CH2O2(.); k>=15; +36: CH3CH2O2(.) + NO -> NO2 + CH3CH2O(.); k>=6; +37: CH3CH2O(.) + O2 -> CH3CHO + HO2(.); k>=0.26; +38: CH3CH2O(.) + NO2 -> CH3CH2NO3; k>=16.2; +39: C3H6 + OH(.) + O2 -> CH3CO2HCH2OH(.); k>=0.075; +40: CH3CO2HCH2OH(.) -> CH3CH2CHO + HO2(.); k>=1.0e-3; +41: CH3CO2HCH2OH(.) + NO -> CHCOHCH2OH(.) + NO2; k>=6; +42: CH3COHCH2OH(.) + O2 -> CH3CHO + HOCH2O2(.); k>=0.015; +43: HOCH2O2(.) + NO -> HOCH2O(.) + NO2; k>=4; +44: HOCH2O2(.) -> HCHO + HO2(.); k>=1.0e-3; +45: HOCH2O(.) -> HCHO + OH(.); k>=3000; +46: C3H6 + OH(.) + O2 -> CH3COHHCH2O2(.); k>=0.05; +47: CH3COHHCH2O2(.) -> CH32CO + HO2(.); k>=1.0e-3; +48: CH3COHHCH2O2(.) + NO -> CH3COHHCH2O(.) + NO2; k>=6; +49: CH3COHHCH2O(.) + O2 -> HCHO + CH3COHHO2(.); k>=0.015; +50: CH3COHHO2(.) -> CH3CHO + HO2(.); k>=0.001; +51: CH3COHHO2(.) + NO -> CH3COHHO(.) + NO2; k>=6; +52: CH3COHHO(.) + O2 -> CH3COOH + HO2(.); k>=0.005; +53: CH2COHHO(.) -> CH3CHO + OH(.); k>=2000; +54: C3H6 + OH(.) -> CH2CHCH2(.) + H2O; k>=5000; +55: CH3CO(.) + O2 -> CH3COO2(.); k>=15; +56: CH3COO2(.) + NO -> CH3COO(.) + NO2; k>=8; +57: CH3COO(.) + NO -> CH3CO(.) + NO2; k>=0.1; +58: CH3COO2(.) + NO2 -> CH3COO2NO2; k>=2; +59: CH3COO(.) -> CH3(.) + CO2; k>=1.0e-4; +60: CH3COO2NO2 + NO -> CH3COO(.) + 2NO2; k>=0.16; +61: CH3COO2NO2 -> CH3COO(.) + NO3; k>=0.01; +62: CH3O2(.) + NO2 -> CH3O2NO2; k>=1.0e-3; +63: CH3O2NO2 + NO -> CH3O(.) + 2NO2; k>=0.1; +64: CH3O2NO2 -> CH3O(.) + NO3; k>=0.05; +65: CH3CH2O2(.) + NO2 -> CH3CH2O2NO2; k>=1.0e-3; +66: CH3CH2O2NO2 + NO -> CH3CH2O(.) + 2NO2; k>=0.1; +67: CH3CH2O2NO2 -> CH3CH2O(.) + NO3; k>=0.05; +68: HCHO -> H(.) + CHO(.); k>=3.3e-5; +69: HCHO + O -> OH(.) + CHO(.); k>=220; +70: HCHO + O3 -> OH(.) + CHO(.) + O2; k>=2.45e-5; +71: HCHO + OH(.) -> CHO(.) + H2O; k>=2.4e+4; +72: CH3CHO -> CH3(.) + CHO(.); k>=3.6e-3; +73: CH3CHO + O -> CH3CO(.) + OH(.); k>=294; +74: CH3CHO + O3 -> CH3CO(.) + OH(.) + O2; k>=5.0e-4; +75: CH3CHO + OH(.) -> CH3CO(.) + H20; k>=2.5e+4; +76: CHO(.) + O2 -> CO + HO2(.); k>=2.5; +77: CHO(.) + OH(.) -> CO + H2O; k>=3.6e+4; +78: 2CH3O(.) -> HCHO + CH3OH; k>=3.6e+5; +79: CH3CH2O(.) + CH3CH2O(.) -> CH3CHO + CH2CH2OH; k>=3.5e+5; +80: CH3COO(.) + CH3O(.) -> HCHO + CH3COOH; k>=3.6e+5; +81: CH3COO(.) + CH3Ch2O(.) -> CH3CHO + CH3COOH; k>=3.6e+5; + + +[NO](0) = 1.612; +[NO2](0) = 0.088; +[O3](0) = 0.000; +[C3H6](0) = 3.290; \ No newline at end of file diff --git a/test/fozone.des b/test/fozone.des new file mode 100644 index 0000000..fd6a114 --- /dev/null +++ b/test/fozone.des @@ -0,0 +1,18 @@ +/* Inorganic Chemistry, 31(17), 3523-3529, 1992 */ + +etime = 10.0; +dtime = 0.05; +prnmode = 1; + + +2: Fe(+2) + O3 -> FeO(+2) + O2; k>=8.2e5; +3: FeO(+2) + Fe(+2) -> 2Fe(+3) + H2O; k>=1.4e5; +4: 2FeO(+2) -> 2Fe(+3) + OH(-) + HO2(-); k>=50; +5: FeO(+2) + H2O2 -> Fe(+3) + HO2 + OH(-); k>=1.0e4; +6: FeO(+2) + HO2 -> Fe(+3) + O2 +OH(-); k>=2.0e6; +11: FeO(+2) -> Fe(+3) + OH + OH(-); k>=1.3e-2; +13: FeO(+2) + OH -> Fe(+3) + HO2(-); k>=1.0e7; + +[O3](0) = 1.3e-4; +[Fe(+2)](0) = 1.1e-4; +[H2O2](0) = 1.0e-5; \ No newline at end of file diff --git a/test/glyco.des b/test/glyco.des new file mode 100644 index 0000000..81dee84 --- /dev/null +++ b/test/glyco.des @@ -0,0 +1,50 @@ +/* Glycolysis Reaction */ +/* Model: Richter and Beth */ +/* */ + +stime = 10.0; +dtime = 0.25; +etime = 100.0; +epsr = 1.0E-4; +epsa = 1.0E-20; + +j0 = 0.0; +k0 = 1.0; +k1 = 100.0; +k2 = 50.0; +ks = 6.0; +kd = 1.0; +Vm = 33.0; +Kf = 0.03; +Ki = 0.05; +Ka = 0.01; +Km = 0.01; +L = 250.0; +Vn = 20.0; +Kn = 1.0; +Kr = 0.3; + +No = 3.3; + + +1: F6Po -> F6P ; v> = k0*[F6Po]; +2: F6P -> P ; k> = j0; +3: FDP -> P ; k> = j0; +4: ATP -> P ; k> = j0; +5: ADP -> P ; k> = j0; +6: ATP + F6P -> FDP + ADP ; v>=Vm*([F6P]/Kf)*([F6P]/Kf+1)^3/(L*(([ATP]/Ki+1)/([AMP]/Ka+1))^4+([F6P]/Kf+1)^4)*[ATP]/(Km+[ATP]); +7: ATP + F6P -> ADP ; k>=ks; +8: 4ADP + FDP -> 4ATP ; v>=Vn*([FDP]/(Kn+[FDP]))*([ADP]/(Kr+[ADP])); +9: AMP + ATP -> 2ADP ; k>=k1; +10: 2ADP -> AMP + ATP ; k>=k2; +11: ATP -> ADP ; k>=kd; + + +[AMP] = No - [ATP] - [ADP]; +[F6Po] = 24.0; +[P] = 0.0; + +[F6P](0) = 1.27E-3; +[FDP](0) = 3.18E-2; +[ATP](0) = 2.0; +[ADP](0) = 1.4; diff --git a/test/grd.des b/test/grd.des new file mode 100644 index 0000000..f4f2b60 --- /dev/null +++ b/test/grd.des @@ -0,0 +1,46 @@ +/* ODEs from Anita Kildebaek Nielsen */ + +method = 2; + +prnmode = 2; + +m = 4.6262e5; +BETA = 0.9847; +De = 5.733e-2; +x0 = 5.02646; + +etime = 15000.0; +dtime = 5; + +epsa = 1.0e-15; +epsr = 1.0e-15; + +konst = 0.01; +integrmin = 0.1; +integrmax = 60; + +PI = 3.1415926535; + +datafile = "grdout"; + +x' = p/m; + +p' = -2*BETA*De*(exp(-BETA*(x-x0)) - exp(-2*BETA*(x-x0))); + + +ar' = (-2/m)*(ar*ar-ai*ai) - BETA*BETA*De*(2*exp(-2*BETA*(x-x0)) - exp(-BETA*(x-x0))); +ai' = (-4/m)*ar*ai; + +gr' = -ai/m + (p*p)/(2*m) - De*(1 + exp(-2*BETA*(x-x0)) - 2*exp(-BETA*(x-x0))); +gi' = 1/m*ar; + + +x(0) = 5.02646; + +p(0) = 0.9; + +ar(0) = 0.1; +ai(0) = konst; + +gr(0) = 0.0; +gi(0) = -0.25*log(((2*konst/PI)^2)^0.5); \ No newline at end of file diff --git a/test/gs.des b/test/gs.des new file mode 100644 index 0000000..fcbbf55 --- /dev/null +++ b/test/gs.des @@ -0,0 +1,39 @@ +/* This example is due to Gray and Scott, "Chemical Oscillations and + Instabilities. Nonlinear Chemical Kinetics", Oxford University Press (1990). + See section 4.1-4.3. +*/ + +/* Simulation parameters */ +method = 1; +etime = 35; +dtime = 0.01; +epsa = 1.0e-20; +epsr = 1.0e-15; +htimemin = 1.0e-20; + + +/* Natural constant - according to Rubber Bible, 1988 */ +R = 8.3144126; + +/* Reactor */ +V = 1.0; +S = 5; +Ta = 400; +c = 0.150; +Xi = 0.30; +Q = 400.0e+3; + +/* Parameters for the second reaction */ +k1 = 0.5; +Ea = 166.0e+3; +Arr = k1*exp(Ea/(R*Ta)); + + +1: P -> A; k>=0.1; +2: A -> B; v>=Arr*exp(-Ea/(R*(Ta+dT)))*[A]; +dT' = (Q*V*Arr*exp(-Ea/(R*(Ta+dT)))*[A]-S*Xi*dT)/(V*c); + +[B] = 0.0; /* for simplicity */ + +[P](0) = 3.0e-3; +dT(0) = 0.0; diff --git a/test/gtf.des b/test/gtf.des new file mode 100644 index 0000000..e04fc99 --- /dev/null +++ b/test/gtf.des @@ -0,0 +1,223 @@ +/* Belousov- Zhabotinsky reaction */ +/* Model: GTF , open system */ +/* Rate constants: FF+rate constants from article */ +/* J.Phys.Chem., 1990,94,7162 */ + +/* Outflow of the dynamical species */ + +/* stime = 0; dtime = 1; etime = 500; epsr = 1L-3; epsa = 1L-20; */ +CeIIIin = 1.66e-4; +j0 = 3.06E-4; +kf1 = 2.3E+9; kr1 = 2.0/55.5; +kf2 = 2.0E+6; kr2 = 2.0E-5; +kf3 = 2.0; kr3 = 3.3; +kf4 = 3.0E+3; kr4 = 7.5E-9; +kf5 = 33.0; kr5 = 2200/55.5; +kf6 = 7.4E+4; kr6 = 1.4E+9; +kf7 = 6.2E+4; kr7 = 7.0E+3; +kf8 = 3.0E-3; kr8 = 200.0; +kf9 = 1.91E+6; +kf10 = 8.2; +kf11 = 0.1; +kf12 = 5.0; +kf13 = 1.0/55.5; +kf14 = 1.0; +kf15 = 1.0; +kf16 = 1.0; +kf17 = 0.09; +kf18 = 0.23; kr18 = 1.7E+4; +kf19 = 0.66; kr19 = 1.7E+4; +kf20 = 140.0; +kf21 = 10.0/55.5; +kf22 = 140.0; +kf23 = 10.0; +kf24 = 1.6E-5; +kf25 = 1.0E+8; +kf26 = 1.0E+9; +kf27 = 1.0E+8/55.5; +kf28 = 1.0E+9/55.5; +kf29 = 1.0E+9/55.5; +kf30 = 1.0E+7/55.5; +kf31 = 5.0E+9/55.5; +kf32 = 5.0E+8; +kf33 = 3.2E+9/55.5; +kf34 = 1.0E+9/55.5; +kf35 = 2.0E+9; +kf36 = 1.0E+9; +kf37 = 5.0E+9; +kf38 = 1.0E+9; +kf39 = 2.0E+9; +kf40 = 1.0E+9; +kf41 = 5.0E+9; +kf42 = 1.2E+9; +kf43 = 1.0E+7; +kf44 = 1.0E+9; +kf45 = 5.0E+9; +kf46 = 1.5E+8; +kf47 = 1.0E+7; +kf48 = 40.0; +kf49 = 1.0E+5; kr49 = 1.0E+5; +kf50 = 1.0E+5; kr50 = 5.0E+2; +kf51 = 2.0E+5; kr51 = 5.0E+3; +kf52 = 1.0E+8; +kf53 = 1.0E+7; +kf54 = 40.0; +kf55 = 1.0E+6; +kf56 = 1.0E+5; +kf57 = 40.0; +kf58 = 1.0E+7; +kf59 = 1.5E+8; +kf60 = 2.0E+7; +kf61 = 2.1E+3; +kf62 = 1.0E+5; +kf63 = 1.0E+6; +kf64 = 5.0E+6; +kf65 = 2.0E+3/55.5; +kf66 = 2.0E+3; +kf67 = 1.0E+2; + +101: HBrO2 -> OP ; k> = j0; +102: Br(-) -> OP ; k> = j0; +103: HOBr -> OP ; k> = j0; +104: Br2 -> OP ; k> = j0; +105: BrO3(-) -> OP ; k> = j0; +106: Br2O4 -> OP ; k> = j0; +107: BrO2 -> OP ; k> = j0; +108: Br -> OP ; k> = j0; +109: CeIV -> OP ; k> = j0; +110: MA -> OP ; k> = j0; +111: ENOL -> OP ; k> = j0; +112: MAR -> OP ; k> = j0; +113: BrMA -> OP ; k> = j0; +114: BrMAR -> OP ; k> = j0; +115: BrO2MA -> OP ; k> = j0; +116: TTA -> OP ; k> = j0; +117: TTAR -> OP ; k> = j0; +118: BrTTA -> OP ; k> = j0; +119: BrO2TTA -> OP ; k> = j0; +120: MOA -> OP ; k> = j0; +121: OA -> OP ; k> = j0; +122: FAR -> OP ; k> = j0; +123: CO2 -> OP ; k> = j0; + + + /* Flow from burettes */ + +201: Bromatin -> BrO3(-) ; k> = j0; +202: MAin -> MA ; k> = j0; + + /* 1. Inorganic subset */ + +1: Br(-) + HOBr + H(+) <=> Br2 + H2O ; k> = kf1; k< = kr1; +2: HBrO2 + Br(-) + H(+) <=> 2HOBr ; k> = kf2; k< = kr2; +3: BrO3(-) + Br(-) + 2H(+) <=> HBrO2 + HOBr ; k> = kf3; k< = kr3; +4: 2HBrO2 <=> HOBr + BrO3(-) + H(+) ; k> = kf4; k< = kr4; +5: BrO3(-) + HBrO2 + H(+) <=> Br2O4 + H2O ; k> = kf5; k< = kr5; +6: Br2O4 <=> 2BrO2 ; k> = kf6; k< = kr6; +7: BrO2 + CeIII + H(+) <=> HBrO2 + CeIV ; k> = kf7; k< = kr7; + + + /* 2. Reactions involving organic species */ + +/* a. Reactions not consuming or producing radicals */ + +8: MA <=> ENOL ; k> = kf8; k< = kr8; +9: ENOL + Br2 -> BrMA + Br(-) + H(+) ; k> = kf9; +10: MA + HOBr -> BrMA + H2O ; k> = kf10; +11: BrMA + HOBr -> Br2MA + H2O ; k> = kf11; +12: TTA + HOBr -> BrTTA + H2O ; k> = kf12; +13: BrO2MA + H2O -> HBrO2 + TTA ; k> = kf13; +14: BrO2MA -> HOBr + MOA ; k> = kf14; +15: BrO2TTA -> HBrO2 + MOA ; k> = kf15; +16: BrTTA -> Br(-) + MOA + H(+) ; k> = kf16; + +/* b. Reactions producing radicals */ + +17: CeIV + BrMA -> CeIII + BrMAR + H(+) ; k> = kf17; +18: CeIV + MA <=> CeIII + MAR + H(+) ; k> = kf18; k< = kr18; +19: CeIV + TTA <=> CeIII + TTAR + H(+) ; k> = kf19; k< = kr19; +20: HOBr + MOA -> Br + OA + FAR ; k> = kf20; +21: CeIV + MOA + H2O -> CeIII + OA + FAR + H(+) ; k> = kf21; +22: HOBr + OA -> Br + FAR + CO2 + H2O ; k> = kf22; +23: CeIV + OA -> CeIII + FAR + CO2 + H(+) ; k> = kf23; +24: BrO3(-) + OA + H(+) -> BrO2 + FAR + CO2 + H2O ; k> = kf24; + +/* c. Reactions consuming radicals */ + +25: 2Br -> Br2 ; k> = kf25; +26: Br + BrMAR -> Br2MA ; k> = kf26; +27: 2BrMAR + H2O -> BrMA + BrTTA ; k> = kf27; +28: BrMAR + MAR + H2O -> MA + BrTTA ; k> = kf28; +29: BrMAR + TTAR + H2O -> TTA + BrTTA ; k> = kf29; +30: BrMAR + CeIV + H2O -> CeIII + BrTTA + H(+) ; k> = kf30; +31: BrMAR + BrO2 + H2O -> HBrO2 + BrTTA ; k> = kf31; +32: BrMAR + FAR -> BrMA + CO2 ; k> = kf32; +33: 2MAR + H2O -> MA + TTA ; k> = kf33; +34: MAR + TTAR + H2O -> 2TTA ; k> = kf34; +35: MAR + FAR -> MA + CO2 ; k> = kf35; +36: MAR + Br -> BrMA ; k> = kf36; +37: MAR + BrO2 -> BrO2MA ; k> = kf37; +38: 2TTAR -> TTA + MOA ; k> = kf38; +39: TTAR + FAR -> TTA + CO2 ; k> = kf39; +40: TTAR + Br -> BrTTA ; k> = kf40; +41: TTAR + BrO2 -> BrO2TTA ; k> = kf41; +42: 2FAR -> OA ; k> = kf42; +43: FAR + CeIV -> CeIII + CO2 + H(+) ; k> = kf43; +44: FAR + Br -> Br(-) + CO2 + H(+) ; k> = kf44; +45: FAR + BrO2 -> HBrO2 + CO2 ; k> = kf45; + +/* d. Reactions preserving radicals */ + +46: MAR + Br2 -> BrMA + Br ; k> = kf46; +47: MAR + HOBr -> TTA + Br ; k> = kf47; +48: MAR + BrO3(-) + H(+) -> TTA + BrO2 ; k> = kf48; +49: MAR + TTA <=> MA + TTAR ; k> = kf49; k< = kr49; +50: MAR + BrMA <=> MA + BrMAR ; k> = kf50; k< = kr50; +51: TTAR + BrMA <=> TTA + BrMAR ; k> = kf51; k< = kr51; +52: TTAR + Br2 -> BrTTA + Br ; k> = kf52; +53: TTAR + HOBr -> MOA + Br + H2O ; k> = kf53; +54: TTAR + BrO3(-) + H(+) -> MOA + BrO2 + H2O ; k> = kf54; +55: BrMAR + Br2 -> Br2MA + Br ; k> = kf55; +56: BrMAR + HOBr -> BrTTA + Br ; k> = kf56; +57: BrMAR + BrO3(-) + H(+) -> BrO2 + BrTTA ; k> = kf57; +58: FAR + BrMA -> Br(-) + MAR + CO2 + H(+) ; k> = kf58; +59: FAR + Br2 -> Br(-) + Br + CO2 + H(+) ; k> = kf59; +60: FAR + HOBr -> Br + CO2 + H2O ; k> = kf60; +61: FAR + BrO3(-) + H(+) -> BrO2 + CO2 + H2O ; k> = kf61; +62: Br + MA -> Br(-) + MAR + H(+) ; k> = kf62; +63: Br + TTA -> Br(-) + TTAR + H(+) ; k> = kf63; +64: Br + BrMA -> Br(-) + BrMAR + H(+) ; k> = kf64; +65: Br + MOA + H2O -> Br(-) + OA + FAR + H(+) ; k> = kf65; +66: Br + OA -> Br(-) + FAR + CO2 + H(+) ; k> = kf66; +67: BrO2 + OA -> HBrO2 + FAR + CO2 ; k> = kf67; + +[H(+)] = 1.29; [OP] = 0.0; [H2O] = 55.5; +[Br2MA] = 0.0; +[MAin] = 0.167; [Bromatin] = 1.2E-2; + +[HBrO2](0) = 2.56536E-06; +[Br(-)](0) = 5.46714E-08; +[HOBr](0) = 2.40102E-08; +[Br2](0) = 1.57731E-07; +[BrO3(-)](0) = 1.04997E-02; +[Br2O4](0) = 2.41967E-10; +[BrO2](0) = 1.11106E-07; +[Br](0) = 1.57731E-07; +[CeIV](0) = 1.65733E-05; +[MA](0) = 1.63783E-01; +[ENOL](0) = 1.63783E-05; +[MAR](0) = 4.77952E-10; +[BrMA](0) = 1.89178E-03; +[BrMAR](0) = 4.57378E-12; +[BrO2MA](0) = 4.57378E-12; +[TTA](0) = 3.45924E-03; +[TTAR](0) = 7.42671E-07; +[BrTTA](0) = 3.45924E-03; +[BrO2TTA](0) = 4.57378E-12; +[MOA](0) = 1.63783E-05; +[OA](0) = 1.63783E-05; +[FAR](0) = 1.63783E-05; +[CO2](0) = 1.63783E-05; + +[CeIII] = CeIIIin - [CeIV]; + diff --git a/test/harm.des b/test/harm.des new file mode 100644 index 0000000..ed786a0 --- /dev/null +++ b/test/harm.des @@ -0,0 +1,15 @@ +/* Simple periodic function */ + +method = 2; +mode = 0; + +#print y; + +etime = 100.0; +dtime = 0.1; + +x' = -y; +y' = x; + +y(0) = 1.0; +x(0) = 0.0; diff --git a/test/hbry1.des b/test/hbry1.des new file mode 100644 index 0000000..d198c73 --- /dev/null +++ b/test/hbry1.des @@ -0,0 +1,22 @@ +/* Reaction of H2 with Br2 */ + +stime=0; dtime=50; etime=2000; +espr=1.0e-6; epsa=1.0e-20; + +T = 600; R=8.314/4.184/1000; /* kcal/grad/mol */ +k1 = (10**10)*exp(-32/R/T); +km1 = 8.8e8; +k2 = (10**11.43)*exp(-19.7/R/T); +km2 = 3.00e8*exp(-2.2/R/T); +k3 = (10**11.97)*exp(-3.7/R/T); +km3 = (10**10.9)*exp(-41.7/R/T); + +method = 1; + +1: Br2 + M <=> 2Br + M; k>=k1; k<=km1; +2: Br + H2 <=> HBr + H; k>=k2; k<=km2; +3: H + Br2 <=> HBr + Br; k>=k3; k<=km3; + + +[H2](0) = 0.001; [Br2](0) = 0.001; +[M] = 0.1; diff --git a/test/hbry2.des b/test/hbry2.des new file mode 100644 index 0000000..3ebac6f --- /dev/null +++ b/test/hbry2.des @@ -0,0 +1,25 @@ +/* Reaction of H2 with Br2 */ + +stime=0; dtime=50; etime=2000; +espr=1.0e-6; epsa=1.0e-20; + +T = 600; R=8.314/4.184/1000; /* kcal/grad/mol */ +k1 = (10**10)*exp(-32/R/T); +km1 = 8.8e8; +k2 = (10**11.43)*exp(-19.7/R/T); +km2 = 3.00e8*exp(-2.2/R/T); +k3 = (10**11.97)*exp(-3.7/R/T); +km3 = (10**10.9)*exp(-41.7/R/T); + +method = 1; + +1: Br2 + M -> 2Br + M; k>=k1; +2: 2Br + M -> Br2 + M; k>=km1; +3: Br + H2 -> HBr + H; k>=k2; +4: HBr + H -> Br + H2; k>=km2; +5: H + Br2 -> HBr + Br; k>=k3; +6: HBr + Br -> H + Br2; k>=km3; + + +[H2](0) = 0.001; [Br2](0) = 0.001; +[M] = 0.1; diff --git a/test/hopf.des b/test/hopf.des new file mode 100644 index 0000000..3fc0325 --- /dev/null +++ b/test/hopf.des @@ -0,0 +1,12 @@ +etime= 60.0; +dtime= 0.1; +epsr= 1.0E-10; +epsa= 1.0E-20; +debug= 2; +m= -0.10; + +x'= m*x+x*y*y-y; +y'= x+m*y-x*x; + +x(0)= 1.0; +y(0)= 1.0; diff --git a/test/hsn90.des b/test/hsn90.des new file mode 100644 index 0000000..473f2d7 --- /dev/null +++ b/test/hsn90.des @@ -0,0 +1,42 @@ + +/* Belousov- Zhabotinsky reaction */ +/* Model: the Oscillatory Bromate Oxidation of Cerium in open systems */ +/* Hynne, Sorensen, Nielsen, 1990 */ + +mixed=2; + +kf1 = 2.0; +kf2 = 3.0e6; +kf3 = 42.0; +kf4 = 3.0E3; +kf5 = 0.104; +kf6 = 0.08; +kf7 = 0.14; + +j0 = 4.7096E-5; + +stime = 0; dtime=1; etime = 16000; epsr = 1.0e-04; epsa = 1.0e-14; +debug= 1; +ref= 3; + + +11: HBrO2 -> P ; k> =j0; +12: Br(-) -> P ; k> =j0; +13: Ce(+4) -> P ; k> =j0; +14: HBrO -> P ; k> =j0; + + +1: BrO3(-) + Br(-) + 2H -> HBrO2 + HBrO ; k> =kf1; +2: HBrO2 + Br(-) + H -> 2HBrO ; k> =kf2; +3: BrO3(-) + HBrO2 + H -> 2HBrO2 + 2Ce(+4) ; k> =kf3; +4: 2HBrO2 -> HBrO + BrO3(-) + H ; k> =kf4; +5: Ce(+4) -> 0.25Br(-) ; k> =kf5; +6: HBrO -> Br(-) ; k> =kf6; +7: HBrO -> P ; k> =kf7; + +[P] = 0; [H] = 0.7; [BrO3(-)] = 0.012; + +[HBrO2](0) = 2.810E-8; +[Br(-)](0) = 0.20968E-6; +[Ce(+4)](0) = 0.19058E-6; +[HBrO](0) = 0.12369E-6; diff --git a/test/kcore3.des b/test/kcore3.des new file mode 100644 index 0000000..a8de346 --- /dev/null +++ b/test/kcore3.des @@ -0,0 +1,42 @@ +/* Belousov- Zhabotinsky reaction */ +/* Model: Ore3 , open system */ +/* Rate constants: FF */ + +stime = 10; +dtime = 0.5; +etime = 2000; +epsr = 1.0E-3; +epsa = 1.0E-15; + +/* j0 = 3.0E-5; */ +kf1 = 2.0; +kf2 = 3.0E+6; +kf3 = 42; +kf4 = 3.0E+3; +kf5 = 0.1320; +/* kf6 = 0.0350; */ + +#parameter j0=<0.0,0.0,0.0,0.0,0.0>; +#parameter kf6=0.0,0.0,0.0,0.0,0.0; + +101: HBrO2 -> P ; k> = j0; +102: Br(-) -> P ; k> = j0; +103: Ce(+4) -> P ; k> = j0; + +1: BrO3(-) + Br(-) + 2H(+) -> HBrO2 + HOBr ; k> = kf1; +2: HBrO2 + Br(-) + H(+) -> 2HOBr ; k> = kf2; +3: BrO3(-) + HBrO2 + H(+) -> 2HBrO2 + 2Ce(+4) ; k> = kf3; +4: 2HBrO2 -> HOBr + BrO3(-) + H(+) ; k> = kf4; +5: Ce(+4) -> Br(-) + Ce(+3) ; k> = kf5; +6: Ce(+4) -> P + Ce(+3) ; k> = kf6; + +[H(+)] = 1.00; +[P] = 0; +[HOBr] = 0.0; +[Ce(+3)] = 0.0; +[BrO3(-)] = 1.20E-2; + +[HBrO2](0) = 3.3E-8; +[Br(-)](0) = 2.4E-7; +[Ce(+)](0) = 1.8E-7; + diff --git a/test/knwang.des b/test/knwang.des new file mode 100644 index 0000000..d708004 --- /dev/null +++ b/test/knwang.des @@ -0,0 +1,37 @@ + +/* Belousov- Zhabotinsky reaction */ +/* Model: the Oscillatory Bromate Oxidation of Cerium in open systems */ + +stime = 0; dtime=1; etime = 4000; epsr = 1.0E-6; epsa = 1.0E-20; + +datafile = "knw09"; + + +Cetot = 0.00133; + +kf1 = 4.0; +kf2 = 2.0E6; +kf3 = 3.0E3; +kf4 = 6.2E4; +kf5 = 30.0; +kf6 = 0.25; +kf7 = 0.0300; +kf8 = 0.0007; + +1: BrO3m + Brm + 2H -> HBrO2 + BrMA ; k> =kf1; +2: HBrO2 + Brm + H -> 2BrMA ; k> =kf2; +3: 2HBrO2 -> BrMA ; k> =kf3; +4: BrO3m + HBrO2 + H -> 2HBrO2 + 2Ce4p ; v> =kf4*[H]*(Cetot-[Ce4p])*[HBrO2]; +5: Ce4p + BrMA -> Brm ; k> =kf5; +6: Ce4p + MA -> P ; k> =kf6; +7: BrMA -> P ; k> =kf7; +8: BrMA -> Brm ; k> =kf8; + +[P] = 0.0; [H] = 1.29; [BrO3m] = 0.080; +[MA] = 0.44; + +[Brm](0) = 1.78E-5; +[BrMA](0) = 1.16782E-2; +[Ce4p](0) = 0; +[HBrO2](0) = 4.86665E-6; + diff --git a/test/lorenz.des b/test/lorenz.des new file mode 100644 index 0000000..7961e35 --- /dev/null +++ b/test/lorenz.des @@ -0,0 +1,25 @@ +/* Lorenz system */ +method = 1; +mode = 0; +screen = 1; +prnmode = 0; + +stime = 0.0; +dtime = 0.5; +etime = 4100.0; +epsr = 1.0E-8; +epsa = 1.0E-8; + +#print X ; + +sigma = 16.0; +gamma = 45.92; +b = 4.0; + +X' = -sigma*X+sigma*Y; +Y' = gamma*X-X*Z-Y; +Z' = X*Y-b*Z; + +X(0) = 10.0; +Y(0) = 1.0; +Z(0) = 0.0; diff --git a/test/lotka.des b/test/lotka.des new file mode 100644 index 0000000..7724017 --- /dev/null +++ b/test/lotka.des @@ -0,0 +1,18 @@ +/* A modified Lotka model (A==B) */ + +mixed = 1; + +method = 1; + +prnmode = 0; + +etime = 1500.0; +dtime=1.0; + +1: A + X -> 2X; k>=0.1; +2: X + Y -> 2Y; k>=0.101; +3: Y + A -> 2A; k>=0.1; + +[A](0) = 2.0; +[X](0) = 2.0; +[Y](0) = 2.0; diff --git a/test/op.des b/test/op.des new file mode 100644 index 0000000..faa5e22 --- /dev/null +++ b/test/op.des @@ -0,0 +1,44 @@ +/* Belousov- Zhabotinsky reaction */ +/* Model: the Oscillatory Bromate Oxidation of Cerium in open systems */ + +j0 = 0.000069; + +stime = 0; +dtime = 0.1; +etime = 10; +epsr = 1.0e-12; +epsa = 1.0e-12; + + +kf1 = 4.55; +kf2 = 3.0e7; +kf3 = 6.8e3; +kf4 = 42; +kf5 = 30; +kf6 = 0.09; +kf7 = 0.00031; + +101: Br(-) -> P ; k> =j0; +102: BrMA -> P ; k> =j0; +103: Ce(+4) -> P ; k> =j0; +104: HBrO2 -> P ; k> =j0; + + +1: BrO(-3) + Br(-) + 2H + MA -> HBrO2 + BrMA ; k>= kf1; +2: HBrO2 + Br(-) + H + 2MA -> 2BrMA ; k>= kf2; +3: 2HBrO2 + MA -> BrO(-3) + BrMA + H ; k>= kf3; +4: BrO(-3) + HBrO2 -> 2HBrO2 + 2Ce(+4) ; k>= kf4; +5: Ce(+4) + BrMA -> Br(-) ; k>= kf5; +6: Ce(+4) -> P ; k>= kf6; +7: BrMA + H -> P ; k>= kf7; + + + +[P] = 0; [H] = 1; [MA] = 0.4; [BrO(-3)] = 0.045; + +[Ce(+4)](0) = 0.0013; +[Br(-)](0) = 0.0000001; +[HBrO2](0) = 0; +[BrMA](0) = 0; + + diff --git a/test/open.des b/test/open.des new file mode 100644 index 0000000..79b7310 --- /dev/null +++ b/test/open.des @@ -0,0 +1,53 @@ + +/* Belousov- Zhabotinsky reaction */ +/* Model: the Oscillatory Bromate Oxidation of Cerium in open systems */ + +mode= 1; + +kf1 = 4.55; +kf2 = 3.0e7; +kf3 = 6.82e3; +kf4 = 42; +kf5 = 30; +kf6 = 0.09; +kf7 = 0.00031; + +j0 = 0.000069; +stime = 0; +dtime=0.10; +etime = 500.0; epsr = 1.0e-06; epsa = 1.0e-14; +epse= 1.0E-14; +debug= 0; +prnmode=0; +datafile = "open1"; + + +ptime= 5.00; +dptime= 20.0; + +#print [Ce(+4)], [BrMA]; + + +12: Br(-) -> P ; k> =j0; +13: BrMA -> P ; k> =j0; +14: Ce(+4) -> P ; k> =j0; +15: HBrO2 -> P ; k> =j0; + + +1: BrO3(-) + Br(-) + 2H + MA -> HBrO2 + BrMA ; k> =kf1; +2: HBrO2 + Br(-) + H + 2MA -> 2BrMA ; k> =kf2; +3: 2HBrO2 + MA -> BrO3(-) + BrMA + H ; k> =kf3; +4: BrO3(-) + HBrO2 -> 2HBrO2 + 2Ce(+4) ; k> =kf4; +5: Ce(+4) + BrMA -> Br(-) ; k> =kf5; +6: Ce(+4) -> P ; k> =kf6; +7: BrMA + H -> P ; k> =kf7; + +[P] = 0; [H] = 1; [MA] = 0.4; [BrO3(-)] = 0.045; + +[Ce(+4)](0) = 4.32066e-7; +[Br(-)](0) = 4.73693e-7; +[HBrO2](0) = 6.35904e-8; +[BrMA](0) = 1.10522e-2; + +pert(Br(-)) = 1.0E-7; +pert(HBrO2) = 1.0E-7; diff --git a/test/ore.kc b/test/ore.kc new file mode 100644 index 0000000..9be6149 --- /dev/null +++ b/test/ore.kc @@ -0,0 +1,46 @@ +/* Belousov- Zhabotinsky reaction */ +/* Model: Oregonator , open system */ +/* Rate constant k1 decreased */ + +stime = 1; dtime = 1; etime = 10; + +htime = 0.005; +epsr = 1.0E-8; +epsa = 1.0E-8; + +#print [HBrO2]; + + + +prnmode = 1; + +j0 = 1.105; +kf1 = 2; +kf2 = 3.00e+6; +kf3 = 42; +kf4 = 3.0e+3; +kf5 = 0.132; +kf6 = 0.035; + +101: HBrO2 -> P ; k> = j0; +102: Br(-) -> P ; k> = j0; +103: Ce(+4) -> P ; k> = j0; + +1: BrO3(-) + Br(-) + 2H -> HBrO2 + HOBr ; k> = kf1; +2: HBrO2 + Br(-) + H -> 2HOBr ; k> = kf2; +3: BrO3(-) + HBrO2 + H -> 2Ce(+4) ; k> = kf3; +4: 2HBrO2 -> HOBr + BrO3(-) + H ; k> = kf4; +5: Ce(+4) + BrMA -> Br(-) ; k> = kf5; +6: Ce(+4) -> P ; k> = kf6; + +[BrMA] = 1; + +[BrO3(-)] = 0.012; [H] = 1.05; [HOBr] = 1; [P] = 0; + +[HBrO2](0) = 2.40592e-08; +[Br(-)](0) = 1.35795e-07; +[Ce(+4)](0) = 8.71103e-08; + + + + diff --git a/test/ore1.kc b/test/ore1.kc new file mode 100644 index 0000000..74ab243 --- /dev/null +++ b/test/ore1.kc @@ -0,0 +1,53 @@ +/* Belousov- Zhabotinsky reaction */ +/* Model: Ore3 , open system */ +/* Rate constants: FF */ + +/* alpha == 8.8439412233931e-1 */ +/* beta == -3.0474328890306e-1 */ + +method = 1; + +kf1 = 2.000; +kf2 = 3.00e+06; +kf3 = 3.00e+03; +kf4 = 42; +kf5 = 1.320e-01; +kf6 = 3.499e-02; + +epsa = 1.0e-8; +epsr = 1.0e-8; + +mgrid = 150; +ngrid = 150; +length = 10; +print = 500; +update = 10; +prnmode = 1; + +/*ptime = 250.0; +dptime = 35; +*/ +etime = 4000.0; +dtime=1.0; + +1: A + Y + 2H -> X + U ; k> = kf1; +2: X + Y + H -> 2U ; k> = kf2; +3: 2X -> U + A + H ; k> = kf3; +4: A + X + H -> 2X + 2Z ; k> = kf4; +5: Z -> Y + C ; k> = kf5; +6: Z -> P ; k> = kf6; + + +[A] = 1.2010890017923e-2; [H] = 1.085; [U] = 0; [C] = 0; [P] = 0; + +/*[X](0) = 3.5542466388658e-8; +[Y](0) = 2.1695957353919e-7; +[Z](0) = 2.1510799247202e-7;*/ +[X](0) = 2.363198e-8; +[Y](0) = 2.488627e-7; +[Z](0) = 1.502933e-7; +D(X) = 1.0e-5; +D(Y) = 1.9e-5; +D(Z) = 0.6e-5; + +pert(X) = 5.0e-9; diff --git a/test/ore2.des b/test/ore2.des new file mode 100644 index 0000000..0055ce4 --- /dev/null +++ b/test/ore2.des @@ -0,0 +1,33 @@ +/* Belousov- Zhabotinsky reaction */ +/* Model: Ore3 , open system */ +/* Rate constants: FF */ + +method = 1; + +kf1 = 2.000; +kf2 = 3.00e+06; +kf3 = 3.00e+03; +kf4 = 42.0; +kf5 = 1.320e-01; +kf6 = 3.499e-02; + +prnmode = 1; + +etime = 7500.0; +dtime = 5.0; + +1: BrO3(-) + Br(-) + 2H(+) -> HBrO2 + HOBr ; k> = kf1; +2: HBrO2 + Br(-) + H(+) -> 2HOBr ; k> = kf2; +3: 2 HBrO2 -> HOBr + BrO3(-) + H(+); k> = kf3; +4: BrO3(-) + HBrO2 + H(+) -> 2 HBrO2 + 2 Ce(+4) ; k> = kf4; +5: Ce(+4) -> Br(-) + Ce(+3) ; k> = kf5; +6: Ce(+4) -> P ; k> = kf6; + +[H(+)] = 1.1; + +[BrO3(-)] = 1.201089e-2; [Ce(+3)] = 0; +[HOBr] = 0; [P] = 0; + +[HBrO2](0) = 3.5542466388658e-8; +[Br(-)](0) = 2.1695957353919e-7; +[Ce(+4)](0) = 2.1510799247202e-7; diff --git a/test/reak b/test/reak new file mode 100644 index 0000000..9332314 --- /dev/null +++ b/test/reak @@ -0,0 +1,76 @@ +stime=0; +dtime=10; +etime=8000; +epsr=1.0e-4; +epsa=1.0e-20; +datafile="r130707"; +method=1; + +#parameter ks= 1.20, 0.0, 1.0, 1.0E-3, 0.00001, 1.0; +/* ks=1.30; */ + +/* #parameter ksb= 2.0E8, 0.0, 1.0, 1.0E3, 0.00001, 1.0; */ +ksb=2.0E6; + +L1=5.0E8; +ktf=1.0E6; +kpb=2.0E6; +kp1=5.0E3; +Krs=1.0E5; +Krp=5.0E6; +vs=2.5E-6; +sigma2=10; +kp2=1.0E5; +L2=100; +p0=1.0e-8; + +1: t00 <=> r00 ;k>=ktf; k<=ktf*L1; +2: r00 + p1 <=> r01 ;k>=2*Krp*kpb; k<=kpb; +3: r00 + s <=> r10 ;k>=2*Krs*ksb; k<=ksb; +4: r01 + p1 <=> r02 ;k>=Krp*kpb; k<=2*kpb; +5: r01 + s <=> r11 ;k>=2*Krs*ksb; k<=ksb; +6: r10 + p1 <=> r01 ;k>=2*Krp*kpb; k<=kpb; +7: r10 + s <=> r20 ;k>=Krs*ksb; k<=2*ksb; +8: r02 + s <=> r12 ;k>=2*Krs*ksb; k<=ksb; +9: r11 + s <=> r21 ;k>=Krs*ksb; k<=2*ksb; +10: r11 + p1 <=> r12 ;k>=Krp*kpb; k<=2*kpb; +11: r20 + p1 <=> r21 ;k>=2*Krp*kpb; k<=kpb; +12: r12 + s <=> r22 ;k>=Krs*ksb; k<=2*ksb; +13: r21 + p1 <=> r22 ;k>=Krp*kpb; k<=2*kpb; + +14: r10 -> p1+r00 ;k>=kp1; +15: r20 -> p1+r10 ;k>=kp1*2; +16: r11 -> p1+r01 ;k>=kp1; +17: r21 -> p1+r11 ;k>=kp1*2; +18: r12 -> p1+r02 ;k>=kp1; +19: r22 -> p1+r12 ;k>=kp1*2; + +20: flow -> s ;k>=vs; +21: p1 -> p2 ;v>=sigma2*p1*(1+p2*kp2)*(1+p2*kp2)/(L2+(1+p2*kp2)*(1+p2*kp2)); +22: p2 -> out ;k>=ks; + +/* +23: p -> tjek ;k>=1; +[p]=[t00]+[r00]+[r10]+[r20]+[r01]+[r02]+[r11]+[r12]+[r21]+[r22]-[tjek]; +[tjek](0)=1.0e-8; +*/ + +[flow]=1; +[t00](0)=1.0e-8; +[r00](0)=0; +[r10](0)=0; +[r20](0)=0; +[r01](0)=0; +[r02](0)=0; +[r11](0)=0; +[r12](0)=0; +[r21](0)=0; +[r22](0)=0; +[s](0)=1.6e-3; +[p1](0)=1.35e-7; +[o2](0)=1.0e-8; + + + + + diff --git a/test/real.des b/test/real.des new file mode 100644 index 0000000..588255c --- /dev/null +++ b/test/real.des @@ -0,0 +1,53 @@ +/* Test model is from "Bifurcation diagram ..." by Ipsen et al. */ + +Ceo = 0.000833333; +j0 = 2.77L-3; +stime = 0; +dtime = 10; +etime = 6000; +epsr = 1.0L-4; +espa = 1.0L-20; + +101: HBrO2 -> P; k> = j0; +101: Br(-) -> P; k> = j0; +103: CeIV -> P; k> = j0; +104: HOBr -> P; k> = j0; +105: BrO2 -> P; k> = j0; +106: Br2 -> P; k> = j0; +107: BrMA -> P; k> = j0; +109: MAR -> P; k> = j0; +110: MAin -> MA; k> = j0; + +1: BrO(-3) + Br(-) + 2H(+) <=> HBrO2 + HOBr; k>=0.01352/0.1/0.26/0.26; k<=3.2; +2: HBrO2 + Br(-) + H(+) -> 2HOBr; k>=5.2L+5/0.26; +3: BrO(-3) + HBrO2 + H(+) <=> 2BrO2 + H2O; k>=0.858/0.1/0.26; k<=4.2L+7/55.5; +4: BrO2 + CeIII + H(+) <=> HBrO2 + CeIV; k>=1.612L+4/0.26; k<=7.0L+3; +5: 2HBrO2 -> HOBr + BrO(-3) + H(+); k>=3.0L+3; +6: Br(-) + HOBr + H(+) <=> Br2 + H2O; k>=6.0L+8/0.26; k<=2/55.5; +7: MA + Br2 -> BrMA + Br(-) + H(+); k>=40.0; +8: MA + HOBr -> BrMA + H2O; k>=8.2; +9: MA + CeIV -> MAR + CeIII + H(+); k>=0.3; +10: BrMA + CeIV -> CeIII + Br(-) + P; k>=30.0; +11: HOBr -> P; k>=0.080; +12: HOBr -> Br(-); k>=0.140; +13: MAR + HOBr -> Br(-) + P; k>=1.0E+7; +14: 2MAR -> MA + P; k>=3.0E+9; +15: MAR + BrMA -> MA + Br(-) + P; k>=2.4E+4; +16: MAR + Br2 -> BrMA + Br(-); k>=1.5L+8; + +[H(+)] = 0.26; +[P] = 0; +[H2O] = 55.5; +[BrO(-3)] = 0.1; +[MAin] = 0.25; +[CeIII] = Ceo-[CeIV]; + +[HBrO2](0) = 2.85055L-7; +[Br(-)](0) = 1.42745L-6; +[CeIV](0) = 2.84792L-6; +[HOBr](0) = 6.13549L-6; +[BrO2](0) = 3.09064L-8; +[Br2](0) = 4.20280L-8; +[MA](0) = 2.47010L-1; +[BrMA](0) = 1.20977L-3; +[MAR](0) = 3.98455L-9; diff --git a/test/selkov.des b/test/selkov.des new file mode 100644 index 0000000..2ccafde --- /dev/null +++ b/test/selkov.des @@ -0,0 +1,13 @@ +/* Selkov */ + +gamma = 3.0; +alpha = 0.3; +etime = 1000.0; + + +x' = 1-x*y^gamma; +y' = alpha*(x*y^gamma-y); + + +x(0) = 3.0; +y(0) = 1.1; \ No newline at end of file diff --git a/test/shn90.des b/test/shn90.des new file mode 100644 index 0000000..840702b --- /dev/null +++ b/test/shn90.des @@ -0,0 +1,52 @@ +/* Belousov- Zhabotinsky reaction */ +/* Model: the Oscillatory Bromate Oxidation of Cerium in open systems */ +/* Sorensen, Hynne, Nielsen, 1990 */ + +mixed=2; + +kf1 = 2.0; kr1= 3.2; +kf2 = 3.0e6; kr2= 2.0E-5; +kf3 = 42.0; kr3= 7.64E5; +kf4 = 8.0E4; kr4= 8.9E3; +kf5 = 3.0E3; kr5= 1.0E-8; +kf6 = 0.02918; +kf7 = 0.078; +kf8 = 0.080; +kf9 = 0.14; + +j0 = 3.3236E-5; +C0 = 8.3E-5; + +stime = 0; dtime=1; etime = 16000; epsr = 1.0e-06; epsa = 1.0e-14; +debug= 1; +ref= 3; + + +11: HBrO2 -> P ; k> =j0; +12: Br(-) -> P ; k> =j0; +13: Ce(+4) -> P ; k> =j0; +14: HBrO -> P ; k> =j0; +15: BrO2 -> P ; k> =j0; + + + +1: BrO3(-) + Br(-) + 2H <-> HBrO2 + HBrO ; k> =kf1; k< = kr1; +2: HBrO2 + Br(-) + H <-> 2HBrO ; k> =kf2; k< = kr2; +3: BrO3(-) + HBrO2 + H <-> 2BrO2 + H2O ; k> =kf3; k< = kr3; +4: BrO2 + Ce(+3) + H <-> HBrO2 + Ce(+4) ; k> =kf4; k< = kr4; +5: 2HBrO2 <-> HBrO + BrO3(-) + H ; k> =kf5; k< = kr5; +6: Ce(+4) -> Br(-) + Ce(+3) ; k> =kf6; +7: Ce(+4) -> P + Ce(+3) ; k> =kf7; +8: HBrO -> Br(-) ; k> =kf8; +9: HBrO -> P ; k> =kf9; + +[P] = 0; [H] = 1.0; [BrO3(-)] = 0.012; +[H2O]= 55.5; +[Ce(+3)]= C0 - [Ce(+4)]; + + +[Ce(+4)](0) = 0.3074E-6; +[Br(-)](0) = 0.2049E-6; +[HBrO](0) = 0.2168E-6; +[HBrO2](0) = 3.480E-8; +[BrO2](0) = 5.000E-9; diff --git a/test/split.des b/test/split.des new file mode 100644 index 0000000..8f32216 --- /dev/null +++ b/test/split.des @@ -0,0 +1,24 @@ +/* Split oregenator, Hynne et al. JCP 98 p.219 (1993) */ + +epsr=1.0e-20; + + +k3=1.0; +k4=2.0; + +1: BrO3(-) + Br(-) -> HBrO2; k>=4.03589; +2: HBrO2 + Br(-) -> P; k>=3.49692e5; +3: BrO3(-) + HBrO2 -> 2HBrO2 + 2Ce(+4); k>=k3; +4: 2HBrO2 -> P; k>=k4; +5: Ce(+4) + BrMA -> Br(-) + P; k>=40.2160; +6: Ce(+4) + MA -> P; k>=1.421018; + +[P]=0.0; +[BrO3(-)]=7.2e-3; [MA]=0.167; [BrMA]=4.8e-3; + +[HBrO2](0)=3.1541108e-6; +[Br(-)](0)=1.5347119e-6; +[Ce(+4)](0)=9.000000e-6; +D(HBrO2)=2.0e-5; /* Buckholtz */ +D(Br(-))=2.08e-5; +D(Ce(+4))=2.0e-6; diff --git a/test/test1.des b/test/test1.des new file mode 100644 index 0000000..4bd2256 --- /dev/null +++ b/test/test1.des @@ -0,0 +1,8 @@ +/* Test of comments */ + +k1 = 1.0; + +1: A -> P; k> = 1.0; + +[A](0) = 1.0; +[P](0) = 0.0; diff --git a/test/test10a.des b/test/test10a.des new file mode 100644 index 0000000..76dc96d --- /dev/null +++ b/test/test10a.des @@ -0,0 +1,6 @@ +x = 1; + +1: A + 2B <-> C; k>=3; k<=4; +2: B -> D; k>=2; + +[A](0) = 1; diff --git a/test/test10b.des b/test/test10b.des new file mode 100644 index 0000000..aeab87b --- /dev/null +++ b/test/test10b.des @@ -0,0 +1,6 @@ +x = 1; + +1: A + 2B <-> C; v>=2*[A]; k<=10; +2: B -> D; k>=2.0; + +[A](0) = 1; diff --git a/test/test11.des b/test/test11.des new file mode 100644 index 0000000..99e8f1c --- /dev/null +++ b/test/test11.des @@ -0,0 +1,7 @@ +etime = 100; + +x' = x^5; +y' = x^y; + +x(0) = 1.0; +y(0) = 1.0; \ No newline at end of file diff --git a/test/test12.des b/test/test12.des new file mode 100644 index 0000000..c9b8c58 --- /dev/null +++ b/test/test12.des @@ -0,0 +1,6 @@ +x = 1; + +1: A + 2B <-> B; k>=3; k<=4; +2: B -> D; k>=2; + +[A](0) = 1; diff --git a/test/test13.des b/test/test13.des new file mode 100644 index 0000000..98ac7c8 --- /dev/null +++ b/test/test13.des @@ -0,0 +1,5 @@ +etime = 10.0; + +x' = sin(time); + +x(0) = 1.0; \ No newline at end of file diff --git a/test/test14a.des b/test/test14a.des new file mode 100644 index 0000000..898c6c1 --- /dev/null +++ b/test/test14a.des @@ -0,0 +1,12 @@ +stime = 0; +dtime = 1.0e-5; +etime = 10.0e-3; + +datafile = "data14a"; + +1: H + NO2 -> OH + NO; k>=2.9e10; +2: OH + OH -> H2O + O; k>=1.55e9; +3: O + OH -> O2 + H; k>=1.1e10; + +[H](0) = 4.5e-7; +[NO2](0) = 4.5e-7; diff --git a/test/test14b.des b/test/test14b.des new file mode 100644 index 0000000..2aeb3ab --- /dev/null +++ b/test/test14b.des @@ -0,0 +1,12 @@ +stime = 0; +dtime = 1.0e-5; +etime = 10.0e-3; + +datafile = "data14b"; + +1: H + NO2 -> OH + NO; k>=2.9e10; +2: 2OH -> H2O + O; k>=1.55e9; +3: O + OH -> O2 + H; k>=1.1e10; + +[H](0) = 4.5e-7; +[NO2](0) = 4.5e-7; diff --git a/test/test15.des b/test/test15.des new file mode 100644 index 0000000..23b1f06 --- /dev/null +++ b/test/test15.des @@ -0,0 +1,6 @@ +etime = 1.0; + +x' = x^2.1; +y' = y^2; + +x(0) = 1; diff --git a/test/test2.des b/test/test2.des new file mode 100644 index 0000000..82ba7a2 --- /dev/null +++ b/test/test2.des @@ -0,0 +1,9 @@ +/* Test of comments */ + +k1 = 1.0; +k2 = 2.0; + +1: A -> P; k> = 1.0; + +[A](0) = 1.0; +[P](0) = 2.0; diff --git a/test/test3.des b/test/test3.des new file mode 100644 index 0000000..592605c --- /dev/null +++ b/test/test3.des @@ -0,0 +1,10 @@ +k = 2.5; + +1: A+2B -> 2C; k>=k; +2: D+2A <-> P; k>=0.1; k<=1.0; +3: 3D+4B -> A; k>=2*k; +4: C -> A+2D; k>=1.0; + +[A](0)=1.0; +[B](0)=k; +M(A) = 18.02; diff --git a/test/test4.des b/test/test4.des new file mode 100644 index 0000000..e515e57 --- /dev/null +++ b/test/test4.des @@ -0,0 +1,3 @@ +1: A+B->C; c(A)=1.1; c(B)=2.3; c(C)=42; k>=11; +2: X+Y->Z; v> = 1/([X]+[Y]); +[A](0) = 0.1; diff --git a/test/test5.des b/test/test5.des new file mode 100644 index 0000000..99f64e1 --- /dev/null +++ b/test/test5.des @@ -0,0 +1,3 @@ +x' = 2*x*y; +y' = -y; +[A](0)=1; diff --git a/test/test6.des b/test/test6.des new file mode 100644 index 0000000..f0d82c6 --- /dev/null +++ b/test/test6.des @@ -0,0 +1,4 @@ +/* Test due to Keld Nielsen */ + +1: A -> B; v> = ([A]+1)^3/([A]/[B]); +[A](0) = 1.0; diff --git a/test/test7.des b/test/test7.des new file mode 100644 index 0000000..6b565e1 --- /dev/null +++ b/test/test7.des @@ -0,0 +1,16 @@ +stime = 10.0; +dtime = 0.25; +etime = 100.0; +epsr = 1.0E-4; +epsa = 1.0E-20; + +#parameter k1= 1.0, 2.0, 3.0, 4.0, 5.0; + +1: A + B -> C ; k> = k1; +2: B + D -> C ; k> = 2.0; + + +[A](0) = 1.27E-3; +[B](0) = 3.18E-2; +[C](0) = 2.0; +[D](0) = 5.5; diff --git a/test/test8.des b/test/test8.des new file mode 100644 index 0000000..bf6f818 --- /dev/null +++ b/test/test8.des @@ -0,0 +1,6 @@ +/* Test of functions */ + +x'=cos(t); +t'=1; + +t(0)=1; x(0)=0; diff --git a/test/test9.des b/test/test9.des new file mode 100644 index 0000000..d8ae8a5 --- /dev/null +++ b/test/test9.des @@ -0,0 +1,5 @@ +x = 1; + +1: A + 2B <-> C; v>=2*[A]; k<=10; + +[A](0) = 1; diff --git a/test/zhab.des b/test/zhab.des new file mode 100644 index 0000000..fa3abfa --- /dev/null +++ b/test/zhab.des @@ -0,0 +1,40 @@ +/* J. Phys. Chem., pp. 7578-7584, 97(29), 1993 */ + + +/* Rate constants at T=20C */ + +k2 = 7.57e+6; +km2 = 0; +k3 = 2; +km3 = 0; +k4 = 8.6e+3; +km4 = 0.0; +k5 = 10; +km5 = 4.2e+6; +k6 = 1.66e+7; /* Phen as catalyst */ +km6 = 0.3; +k7 = 3.0e-6; +km7 = 0; +k9 = 5.0e-6; + + +/* From fig. 4 */ + +A = 0.25; +h0 = 0.59; +C = 2.0e-3; +B = 0.016; +q = 0.5; + + +k4star = k4*(1+0.87*h0); + + + +X' = (-k2*X+k3*A)/(k2*X+k3*A)*(q*k7*k8*(B*Z)/(k8+km7*h0*(C-Z))+k9*B)- + 2*k4star*X*X - k5*h0*A*X + km5*U*U + k6*U*(C-Z) - km6*X*Z; + +U' = 2*k5*h0*A*X - 2*km5*U*U - k6*U*(C-Z) + km6*X*Z; + +Z' = k6*U*(C-Z) - km6*X*Z - (k7*k8*B*Z)/(k8+km7*h0*(C-Z)); +