Home

Context Navigation

create_kpp_module.C @ 4841

Last change on this file since 4841 was 4841, checked in by forkel, 3 years ago
updated copyright statements for chem_gasphase_mod.f90. This must be done in UTIL/chemistry/gasphase_preproc/kpp4palm/templates/module_header and NOT in SOURCE/chem_gasphase_mod.f90.
File size: 25.8 KB

Line
1
2	// ############################################################################
3	//
4	// create_kpp_module
5	//
6	// create scalar code from .f90 sources created by KPP
7	//
8	// COPYRIGHT Klaus Ketelsen and MPI-CH April 2007
9	//
10	// ############################################################################
11	//
12	//
13	//Former revisions:
14	//-----------------
15	// Update of copyright statements in templates/module_header (12.01.2021, forkel)
16	//
17	// alphabetic ordering of PUBLIC statments in templates/module_header (28.03.2019, forkel)
18	//
19	// renamed get_mechanismname to get_mechanism_name (26.03.2019, forkel)
20	//
21	//
22	// Deleted $Id since document_changes does not work for C and C++ (15.03.2019, forkel)
23	//
24	// OpenMP version (15.03.2019, ketelsen)
25	//
26	// Added vector switch Kacc,Krej,IERRV, Commented add_line for istatf, (05.03.2019, forkel)
27	// added ,pe after ierr_u,
28	//
29	// Added create_set_cs and cs_mech and get_mechanismname in module_header (05.03.2019, forkel)
30	//
31	// exclude kco_compress from handling by global_variables2vector (30.10.2018, forkel)
32	//
33	// Added automatic line with mechanism name (read mech_list) (25.09.2018, forkel)
34	//
35	// Added vl_glo = size(tempi,1) (20.09.2018, forkel)
36	//
37	// Removed creation of fill_ Subroutine and creation of calls thereof (18.09.2018, ketelsen)
38	//
39	// Fix in order not to loose the values of qvap and fakt (12.09.2018, forkel)
40	//
41	// Bug fixes: moved kppi.add_line(" CALL initialize after fakt = fakti(is)
42	// Deleted definition of qvap,fakt in create_kpp_integrate again (03.09.2018, forkel)
43	//
44	// Changes for vector mode (edit_WAXPY, edit_FunTemplate, edit_JacTemplate,
45	// some cleanup of comments, various changes in create_kpp_integrate) (July 2018, ketelsen)
46	//
47	//
48	// Added qvap and fakt (June 2018, forkel)
49	// --> Change in module_header: qvap, fakt added (June 2018, forkel)
50	//
51	// re-established original uppercase/lowercase (June 2018, forkel)
52	// --> Change in module_header: reset case in Initialize, Integrate, and
53	// Update_rconst (June 2018, forkel)
54	//
55	// Removed preprocessor directive __chem again (2017-09-14, forkel)
56	//
57	// Added phot (2017-09-14, forkel)
58	// --> Change in module_header: Variables for photolyis added (2017-09-14, forkel)
59	//
60	// change of some output to lowercase with uppercase Fortran (2017, forkel)
61	//
62	// Intial version of KP4 adapted to PALM (Nov. 2016, ketelsen)
63	//
64	#include <stdio.h>
65	// stdlib is necessary to define getenv:
66	#include <stdlib.h>
67
68	#include "create_kpp_module.h"
69	#include "utils.h"
70
71	void create_kpp_module::do_work (string s) {
72	vector<fortran_file>::iterator it;
73	vector<string>::iterator ic;
74	vector<Vvar>::iterator iv;
75
76	expand_decomp exp_de;
77
78	prefix = s;
79	module_name = prefix;
80
81	cout << "Create " << module_name << " from kpp Fortran sources" <<endl;
82	cout << "Vector mode " << kpp_switches.is_vector() <<endl;
83	cout << "De_indexing " << kpp_switches.de_indexing() <<endl;
84
85	create_fortran_files_and_read();
86
87	// Generate first module lines
88
89	string first_line="MODULE " + module_name;
90	mz_kpp.add_line(first_line);
91	mz_kpp.add_line(" ");
92
93	// string e5_line = first_line +"_e5";
94	// e5_kpp.add_line(e5_line);
95	// e5_line = " USE " + module_name;
96	// e5_kpp.add_line(e5_line);
97	// e5_kpp.add_line(" ");
98
99	// edit include files
100
101	for(it=kpp_includes.begin();it!=kpp_includes.end();it++) {
102	it->edit_inc(header_variables);
103
104	// Create variable Species list and vector variable list
105
106	if(it->get_name() == module_name + "_Parameters") {
107	it->create_species_list(species_list);
108	}
109	if(it->get_name() == module_name + "_Global") {
110	it->vector_variable_list(Vvar_list);
111	}
112	}
113
114	// Prepare expansion of decomposition subroutine
115
116	if(kpp_switches.de_indexing () > 0 ) {
117	exp_de.create_sparse_info (kpp_includes, module_name);
118	}
119
120	// edit FORTRAN files
121
122	for(it=kpp_files.begin();it!=kpp_files.end();it++) {
123	it->edit_fortran ();
124	}
125
126	// Generate a list of single subroutines from kpp-files
127	// kpp files are modules containing several subroutines
128
129	copy_files_to_subroutines ();
130
131	// All header_variables to include list
132
133	kpp_includes.push_back(header_variables);
134
135	// Create decomposition subroutine
136	if(kpp_switches.de_indexing () > 0 ) {
137	exp_de.create_routine (kpp_subroutines);
138	}
139
140	if(kpp_switches.is_vector()) {
141
142	cout << "##### Hier kpp_switches.is_vector " <<endl;
143	// Change header section
144	for(it=kpp_includes.begin();it!=kpp_includes.end();it++) {
145	it->edit_inc_vec(global_variable_list);
146	}
147
148	// Change global variables to vector (except for kp4_compress, which has already the right form)
149
150	for(it=kpp_subroutines.begin();it!=kpp_subroutines.end();it++) {
151	if(it->get_name() != "kco_compress" ) {
152	it->global_variables2vector (global_variable_list);
153	}
154	}
155
156	// Edit individual subroutines
157
158	for(it=kpp_subroutines.begin();it!=kpp_subroutines.end();it++) {
159	if(it->get_name() == "KppDecomp") {
160	it->edit_KppDecomp();
161	}
162	if(it->get_name() == "KppSolve") {
163	it->edit_KppSolve();
164	}
165	if(it->get_name() == "Jac_SP" ) {
166	it->edit_Jac_SP();
167	}
168	if(it->get_name() == "Fun" ) {
169	it->edit_Fun();
170	}
171	if(it->get_name() == "WAXPY" ) {
172	it->edit_WAXPY();
173	}
174	if(it->get_name() == "FunTemplate" ) {
175	it->edit_FunTemplate();
176	}
177	if(it->get_name() == "JacTemplate" ) {
178	it->edit_JacTemplate();
179	}
180	}
181	}
182
183	// Update_RCONST has to be changed also in scalar mode
184
185	for(it=kpp_subroutines.begin();it!=kpp_subroutines.end();it++) {
186	if(it->get_name() == "Update_RCONST") {
187	it->edit_Update_RCONST(Vvar_list);
188	}
189
190	if(it->get_name() == "Initialize") {
191	it->edit_Initialize(Vvar_list);
192	}
193
194	}
195
196	// Add Solver template to subroutine list
197	if(kpp_switches.is_vector()) {
198	add_solver_to_subroutine_list ();
199	}
200
201	// The module header will be taken from ../templates/module_header.
202	// Please edit if header has to be changed.
203
204	generate_module_header();
205
206	// Create subroutine to communicate mechanism name to other modules
207	create_set_cs();
208
209	// Create kpp_integrate subroutine (chem_gasphase_integrate) for skalar and vector mode
210
211	create_kpp_integrate();
212	// Copy include files
213
214	for(it=kpp_includes.begin();it!=kpp_includes.end();it++) {
215	it->copy_to_MZ_KPP(mz_kpp);
216	}
217
218	mz_kpp.add_line(" ");
219	mz_kpp.add_line("! Interface Block ");
220	mz_kpp.add_line(" ");
221	for(it=kpp_subroutines.begin();it!=kpp_subroutines.end();it++) {
222	string buf;
223
224	string prefix = " ";
225	for(ic=interface_ignore.begin();ic!=interface_ignore.end();ic++) {
226	if(it->get_name() == *ic) {
227	prefix = "!interface not working ";
228	break;
229	}
230	}
231
232	buf = prefix + "interface " + it->get_name() ;
233	mz_kpp.add_line(buf);
234	buf = prefix + " module procedure " + it->get_name();
235	mz_kpp.add_line(buf);
236	buf = prefix + "end interface " + it->get_name();
237	mz_kpp.add_line(buf);
238	mz_kpp.add_line(" ");
239	}
240
241	mz_kpp.add_line(" ");
242
243	// Declare variables THREADPRIVATE for OpenMP version
244
245	mz_kpp.add_line(" ! OpenMP directives generated by kp4 ");
246	mz_kpp.add_line(" ");
247	mz_kpp.add_line(" !$OMP THREADPRIVATE (vl,vl_glo,is,ie,data_loaded)");
248	mz_kpp.add_line(" !$OMP THREADPRIVATE (c,var,fix,rconst,time,temp,stepmin,cfactor)");
249	mz_kpp.add_line(" !$OMP THREADPRIVATE (qvap,fakt,cs_mech,a,icntrl,rcntrl)");
250	mz_kpp.add_line(" ");
251	if(kpp_switches.is_vector()) {
252	mz_kpp.add_line(" ! Vector mode Only ");
253	mz_kpp.add_line(" ");
254	mz_kpp.add_line(" !$OMP THREADPRIVATE (kacc,krej,ierrv)");
255	mz_kpp.add_line(" !$OMP THREADPRIVATE (kpoints,kpoints_SAVE,index_org,done_check,index_step,cell_done)");
256	mz_kpp.add_line(" !$OMP THREADPRIVATE (f_done,kacc_done,krej_done,ierr_done,compress_done)");
257	mz_kpp.add_line(" ");
258	}
259
260
261	// Copy FORTRAN subroutines to mz_kpp
262
263	mz_kpp.add_line(" CONTAINS");
264
265	for(it=kpp_subroutines.begin();it!=kpp_subroutines.end();it++) {
266	mz_kpp.add_line(" ");
267	it->copy_to_MZ_KPP(mz_kpp);
268	}
269
270	// Finish module
271
272	string last_line="end module " + module_name;
273	mz_kpp.add_line("");
274	mz_kpp.add_line(last_line);
275
276	// Write the complete module to file: mz_kpp.f
277
278	write_module_file();
279
280	return;
281	}
282
283	void create_kpp_module::create_fortran_files_and_read() {
284
285	string name;
286	ifstream in,in_c,in_b,in_i;
287	fortran_file f_file;
288	vector<fortran_file>::iterator it;
289
290	// Open file with list of FORTRAN routines
291
292	in.open("file_list");
293	if( !in ) {
294	cout << "cannot open " << endl; my_abort("file_list");
295	}
296
297	// Create kpp_fortran routines
298	while ( 1 ) {
299	in >> name;
300	if( in.eof() ) break;
301	if( in.bad() ) my_abort("ERROR_READ_1");
302	f_file.set_name(name);
303	kpp_files.push_back(f_file);
304	}
305	in.close();
306
307	// Read FORTRAN code
308
309	for(it=kpp_files.begin();it!=kpp_files.end();it++) {
310	it->read();
311	}
312
313	// Open file with list of include files
314
315	in_c.open("include_list");
316	if( !in_c ) {
317	cout << "cannot open " << endl; my_abort("include_list");
318	}
319
320	// Create kpp_includes vector
321	while ( 1 ) {
322	in_c >> name;
323	if( in_c.eof() ) break;
324	if( in_c.bad() ) my_abort("ERROR_READ_3");
325	f_file.set_name(name);
326	kpp_includes.push_back(f_file);
327	}
328	in_c.close();
329
330	// Read include files
331
332	for(it=kpp_includes.begin();it!=kpp_includes.end();it++) {
333	it->read();
334	}
335
336	// Read Ignore list
337
338	in_i.open("interface_ignore_list");
339	if( !in_i ) {
340	cout << "cannot open " << endl; my_abort("include_list");
341	}
342
343	// Create kpp_includes vector
344	while ( 1 ) {
345	in_i >> name;
346	if( in_i.eof() ) break;
347	if( in_i.bad() ) my_abort("ERROR_READ_4");
348	interface_ignore.push_back(name);
349	}
350	in_c.close();
351
352	}
353
354	void create_kpp_module::copy_files_to_subroutines () {
355	string name;
356	ifstream in;
357	fortran_file s_file;
358	vector<fortran_file>::iterator it;
359
360	// Open file with list of FORTRAN routines
361
362	in.open("subroutine_list");
363	if( !in ) {
364	cout << "cannot open " << endl; my_abort("subroutine_list");
365	}
366
367	// Create vector kpp_subroutines
368
369	while ( 1 ) {
370	in >> name;
371	if( in.eof() ) break;
372	if( in.bad() ) my_abort("ERROR_READ_S1");
373	s_file.set_name(name);
374	kpp_subroutines.push_back(s_file);
375	}
376	in.close();
377
378	header_variables.add_line(" ");
379	header_variables.add_line("! variable definations from individual module headers ");
380	header_variables.add_line(" ");
381
382	// Loop over all FORTRAN Files
383
384	for(it=kpp_files.begin();it!=kpp_files.end();it++) {
385	it->copy_to_subroutine_vector(kpp_subroutines, header_variables);
386	}
387	}
388
389	void create_kpp_module::add_solver_to_subroutine_list () {
390	fortran_file s_file;
391
392	string solver_name = getenv("KPP_SOLVER");
393	cout << "KPP_SOLVER " <<solver_name <<endl;
394
395	s_file.set_name(solver_name);
396	s_file.read();
397	kpp_subroutines.push_back(s_file);
398
399	return;
400	}
401
402	void create_kpp_module::generate_module_header() {
403
404	string buf;
405	ifstream in;
406	ifstream in_e5;
407	program_line line;
408	vector<fortran_file>::iterator it;
409	char distr[2];
410	string diline;
411
412	// Read mechanism from mech_list
413
414	in.open("mech_list");
415	if( !in ) {
416	cout << "cannot open " << endl; my_abort("mech_list");
417	}
418
419	while ( 1 ) {
420	getline (in, buf);
421	if( in.eof() ) break;
422	if( in.bad() ) my_abort("ERROR_READ_4");
423	line.set_line(buf);
424	mz_kpp.add_line(line);
425	}
426	in.close();
427
428
429	// Read Modul Header from file $MZ_KPP_HOME/templates/module_header
430
431	in.open("module_header");
432	if( !in ) {
433	cout << "cannot open " << endl; my_abort("module_header");
434	}
435
436	while ( 1 ) {
437	getline (in, buf);
438	if( in.eof() ) break;
439	if( in.bad() ) my_abort("ERROR_READ_4");
440	line.set_line(buf);
441	mz_kpp.add_line(line);
442	}
443	mz_kpp.add_line(" ");
444	mz_kpp.add_line("! Variables used for vector mode ");
445	mz_kpp.add_line(" ");
446	if(kpp_switches.is_vector()) {
447	mz_kpp.add_line(" logical,parameter :: L_VECTOR = .TRUE. ");
448	} else {
449	mz_kpp.add_line(" logical,parameter :: L_VECTOR = .FALSE. ");
450	}
451	// mz_pj_20070531+
452	sprintf(distr,"%i",kpp_switches.de_indexing());
453	diline = distr ;
454	mz_kpp.add_line(" integer,parameter :: I_LU_DI = " + diline );
455	// mz_pj_20070531-
456
457	mz_kpp.add_line(" integer,parameter :: VL_DIM = "
458	+ kpp_switches.get_vector_length() );
459	mz_kpp.add_line(" integer :: vl ");
460	mz_kpp.add_line(" ");
461	mz_kpp.add_line(" integer :: VL_glo ");
462	mz_kpp.add_line(" integer :: is,ie ");
463	mz_kpp.add_line(" ");
464	mz_kpp.add_line(" ");
465	if(kpp_switches.is_vector()) {
466	mz_kpp.add_line(" integer, dimension(VL_dim) :: Kacc,Krej ");
467	mz_kpp.add_line(" integer, dimension(VL_dim) :: IERRV ");
468	}
469	mz_kpp.add_line(" logical :: data_loaded = .false. ");
470	if(kpp_switches.is_vector()) {
471	mz_kpp.add_line(" REAL(dp),POINTER,DIMENSION(:,:),CONTIGUOUS :: var ");
472	} else {
473	mz_kpp.add_line(" REAL(dp),POINTER,DIMENSION(:),CONTIGUOUS :: var ");
474	}
475	in.close();
476
477	return;
478	}
479
480	void create_kpp_module::write_module_file() {
481	ofstream out;
482	ofstream out_e5;
483
484	string out_file = "kk_kpp.f90";
485	out.open(out_file.c_str(), ios::out);
486	if( !out ) {
487	cout << "cannot open " << endl; my_abort(out_file);
488	}
489
490	mz_kpp.write_file (out);
491
492	out.close();
493
494
495	return;
496	}
497
498	void create_kpp_module::create_set_cs() {
499	fortran_file kppi;
500	vector<Vvar>::iterator iv;
501	string xline;
502
503	string buf;
504	ifstream in;
505	program_line line;
506
507	kppi.set_name("get_mechanism_name");
508	kppi.add_line("SUBROUTINE get_mechanism_name ");
509	kppi.add_line(" ");
510	kppi.add_line(" IMPLICIT NONE ");
511	// Read mechanism from set_cm
512	// Tis got an own own subroutine to aviod being called at each timestep
513
514	in.open("set_cm");
515	if( !in ) {
516	cout << "cannot open " << endl; my_abort("set_cm");
517	}
518
519	while ( 1 ) {
520	getline (in, buf);
521	if( in.eof() ) break;
522	if( in.bad() ) my_abort("ERROR_READ_4");
523	line.set_line(buf);
524	kppi.add_line(line);
525	}
526	in.close();
527
528	kppi.add_line(" ");
529	kppi.add_line(" return ");
530	kppi.add_line("END SUBROUTINE get_mechanism_name ");
531	kppi.add_line(" ");
532	kpp_subroutines.push_back(kppi);
533
534	return;
535	}
536
537
538	void create_kpp_module::create_kpp_integrate() {
539	fortran_file kppi;
540	vector<Vvar>::iterator iv;
541	string xline;
542
543
544	kppi.set_name("chem_gasphase_integrate");
545
546	kppi.add_line("SUBROUTINE chem_gasphase_integrate (time_step_len, conc, tempi, qvapi, fakti, photo, ierrf, xnacc, xnrej, istatus, l_debug, pe, icntrl_i, rcntrl_i ) ");
547	kppi.add_line(" ");
548	kppi.add_line(" IMPLICIT NONE ");
549	kppi.add_line(" ");
550
551	kppi.add_line(" REAL(dp), INTENT(IN) :: time_step_len ");
552	kppi.add_line(" REAL(dp), DIMENSION(:,:), INTENT(INOUT) :: conc ");
553	kppi.add_line(" REAL(dp), DIMENSION(:,:), INTENT(IN) :: photo ");
554	kppi.add_line(" REAL(dp), DIMENSION(:), INTENT(IN) :: tempi ");
555	kppi.add_line(" REAL(dp), DIMENSION(:), INTENT(IN) :: qvapi ");
556	kppi.add_line(" REAL(dp), DIMENSION(:), INTENT(IN) :: fakti ");
557	kppi.add_line(" INTEGER, INTENT(OUT), OPTIONAL :: ierrf(:) ");
558	kppi.add_line(" INTEGER, INTENT(OUT), OPTIONAL :: xNacc(:) ");
559	kppi.add_line(" INTEGER, INTENT(OUT), OPTIONAL :: xNrej(:) ");
560	kppi.add_line(" INTEGER, INTENT(INOUT), OPTIONAL :: istatus(:) ");
561	kppi.add_line(" INTEGER, INTENT(IN), OPTIONAL :: PE ");
562	kppi.add_line(" LOGICAL, INTENT(IN), OPTIONAL :: l_debug ");
563	kppi.add_line(" INTEGER, DIMENSION(nkppctrl),INTENT(IN), OPTIONAL :: icntrl_i ");
564	kppi.add_line(" REAL(dp), DIMENSION(nkppctrl),INTENT(IN), OPTIONAL :: rcntrl_i ");
565	kppi.add_line(" ");
566	kppi.add_line(" INTEGER :: k ! loop variable ");
567	kppi.add_line(" REAL(dp) :: dt ");
568	kppi.add_line(" integer, dimension(20) :: istatus_u ");
569	kppi.add_line(" integer :: ierr_u ");
570	// kppi.add_line(" integer :: istatf ");
571	kppi.add_line(" integer :: vl_dim_lo ");
572	kppi.add_line(" ");
573	kppi.add_line(" ");
574	kppi.add_line(" if (present (istatus) ) istatus = 0 ");
575	kppi.add_line(" if (present (icntrl_i) ) icntrl = icntrl_i ");
576	kppi.add_line(" if (present (rcntrl_i) ) rcntrl = rcntrl_i ");
577	kppi.add_line(" ");
578	if(kpp_switches.is_vector()) {
579	kppi.add_line(" var => c(:,1:nvar) ");
580	} else {
581	kppi.add_line(" var => c(1:nvar) ");
582	}
583	kppi.add_line(" ");
584	kppi.add_line(" vl_glo = size(tempi,1) ");
585	kppi.add_line(" ");
586	kppi.add_line(" vl_dim_lo = VL_DIM ");
587	kppi.add_line(" DO k=1,VL_glo,vl_dim_lo ");
588	kppi.add_line(" is = k ");
589	kppi.add_line(" ie = min(k+vl_dim_lo-1,VL_glo) ");
590	kppi.add_line(" vl = ie-is+1 ");
591
592	kppi.add_line(" ");
593	if(kpp_switches.is_vector()) {
594	kppi.add_line(" C(1:vl,:) = Conc(is:ie,:) ");
595	} else {
596	kppi.add_line(" C(:) = Conc(is,:) ");
597	}
598
599	kppi.add_line(" ");
600	if(kpp_switches.is_vector()) {
601	kppi.add_line(" temp(1:vl) = tempi(is:ie) ");
602	} else {
603	kppi.add_line(" temp = tempi(is) ");
604	}
605	kppi.add_line(" ");
606	if(kpp_switches.is_vector()) {
607	kppi.add_line(" qvap(1:vl) = qvapi(is:ie) ");
608	} else {
609	kppi.add_line(" qvap = qvapi(is) ");
610	}
611	kppi.add_line(" ");
612	if(kpp_switches.is_vector()) {
613	kppi.add_line(" fakt(1:vl) = fakti(is:ie) ");
614	} else {
615	kppi.add_line(" fakt = fakti(is) ");
616	}
617
618	kppi.add_line(" ");
619	kppi.add_line(" CALL initialize ");
620
621	kppi.add_line(" ");
622	if(kpp_switches.is_vector()) {
623	kppi.add_line(" phot(1:vl,:) = photo(is:ie,:) ");
624	} else {
625	kppi.add_line(" phot(:) = photo(is,:) ");
626	}
627	kppi.add_line(" ");
628	kppi.add_line(" CALL update_rconst ");
629	kppi.add_line(" ");
630	kppi.add_line(" dt = time_step_len ");
631	kppi.add_line(" ");
632	kppi.add_line(" ! integrate from t=0 to t=dt ");
633	kppi.add_line(" CALL integrate(0._dp, dt, icntrl, rcntrl, istatus_u = istatus_u, ierr_u=ierr_u)");
634	kppi.add_line(" ");
635	kppi.add_line(" ");
636	if(kpp_switches.is_vector()) {
637	kppi.add_line(" Conc(is:ie,:) = C(1:VL,:) ");
638	} else {
639	kppi.add_line(" IF (PRESENT(l_debug) .AND. PRESENT(PE)) THEN ");
640	kppi.add_line(" IF (l_debug) CALL error_output(Conc(is,:),ierr_u,pe) ");
641	kppi.add_line(" ENDIF ");
642	kppi.add_line(" ");
643	kppi.add_line(" Conc(is,:) = C(:) ");
644	}
645
646	kppi.add_line(" ");
647	kppi.add_line(" ! Return Diagnostic Information ");
648	kppi.add_line(" ");
649	if(kpp_switches.is_vector()) {
650	kppi.add_line(" if(Present(ierrf)) ierrf(is:ie) = IERRV(1:VL) ");
651	kppi.add_line(" if(Present(xNacc)) xNacc(is:ie) = Kacc(1:VL) ");
652	kppi.add_line(" if(Present(xNrej)) xNrej(is:ie) = Krej(1:VL) ");
653	} else {
654	kppi.add_line(" if(Present(ierrf)) ierrf(is) = IERR_U ");
655	kppi.add_line(" if(Present(xNacc)) xNacc(is) = istatus_u(4) ");
656	kppi.add_line(" if(Present(xNrej)) xNrej(is) = istatus_u(5) ");
657	}
658	kppi.add_line(" ");
659	kppi.add_line(" if (present (istatus) ) then ");
660	if(kpp_switches.is_vector()) {
661	kppi.add_line(" istatus(4) = istatus(4) + sum(Kacc(1:VL)) ");
662	kppi.add_line(" istatus(5) = istatus(5) + sum(Krej(1:VL)) ");
663	kppi.add_line(" istatus(3) = istatus(4) + istatus(5) ");
664	kppi.add_line(" istatus(6) = istatus(6) + istatus_u(6) ");
665	kppi.add_line(" istatus(7) = istatus(7) + istatus_u(7) ");
666	} else {
667	kppi.add_line(" istatus(1:8) = istatus(1:8) + istatus_u(1:8) ");
668	}
669	kppi.add_line(" end if ");
670	kppi.add_line(" ");
671	kppi.add_line(" END DO ");
672	kppi.add_line(" ");
673
674	kppi.add_line(" ");
675	kppi.add_line("! Deallocate input arrays ");
676	kppi.add_line(" ");
677	for(iv=Vvar_list.begin();iv!=Vvar_list.end();iv++) {
678	// kppi.add_line(" if (allocated("+ iv->name +")) deallocate("+ iv->name +" ) ");
679	}
680
681	kppi.add_line(" ");
682	kppi.add_line(" data_loaded = .false. ");
683	kppi.add_line(" ");
684	kppi.add_line(" return ");
685	kppi.add_line("END SUBROUTINE chem_gasphase_integrate ");
686
687	// e5_subroutines.push_back(kppi);
688	kpp_subroutines.push_back(kppi);
689
690	return;
691	}
692

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/create_kpp_module.C @ 4841

Download in other formats: