Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

source: palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/fortran_file_vec.C @ 3458

Last change on this file since 3458 was 3458, checked in by kanani, 6 years ago

Reintegrated fixes/changes from branch chemistry
File size: 9.7 KB
Line 
1
2// ############################################################################
3//
4//     create_mz_kpp_module                       
5//
6//     create vectorcode from .90 sources created by KPP to be used in MESSy
7//
8//     COPYRIGHT Klaus Ketelsen and MPI-CH   April 2007
9//
10// ############################################################################
11//
12//Current revisions:
13//------------------
14//
15//
16//Former revisions:
17//-----------------------
18//$Id: fortran_file_vec.C 3327 2018-10-09 19:55:00Z forkel $
19// Line 112: do k=is,ie bydo k=1,vl; line 156 ff: replaced index k by j (18.09.2018, ketelsen)
20//
21// added edit_Initialize, changed loop direction for update_rconst in edit_Update_RCONST (Sept. 2018, forkel)
22//
23// initial version       (Nov. 2016, ketelsen)
24//
25
26#include <fstream>
27#include "fortran_file.h"
28
29#include "utils.h"
30
31
32void fortran_file::edit_inc_vec (vector<string> &gvl) {
33  vector<program_line>::iterator     ip;
34  vector<string>::iterator           ig;
35
36  cout << "Handling include: " <<name <<endl;
37
38  for (ip=pline.begin(); ip != pline.end(); ip++) {
39    if(ip->get_token(0) == "REAL")  {
40      int pos = ip->get_token_number_from_string("::");
41      if(pos > 1) { 
42        pos ++;
43        for (ig=gvl.begin(); ig != gvl.end(); ig++) {
44          string var_name = *ig;
45          if(ip->get_token(pos) == var_name)  {
46            ip->update_token(pos+1,"(VL_DIM,"); 
47          }
48        }
49      }
50    }
51    if(ip->get_token(0) == "EQUIVALENCE" && ip->get_token(2) == "C" )  {
52      ip->update_token(3,"(1,");
53      ip->update_token(9,"(1,");
54    }
55  }
56
57  return;
58}
59
60void fortran_file::global_variables2vector (vector<string> &gvl) {
61  vector<program_line>::iterator     ip;
62  vector<string>::iterator           ig;
63
64  cout << "Handling subroutine: " <<name <<endl;
65
66  for (ip=pline.begin(); ip != pline.end(); ip++) {
67    for (ig=gvl.begin(); ig != gvl.end(); ig++) {
68      string var_name = *ig;
69      ip->change_variable_to_vector (var_name);
70    }
71  }
72
73  return;
74}
75
76void fortran_file::edit_Update_RCONST (vector <Vvar> &var_list) { 
77  vector<program_line>::iterator     ip;
78  vector<Vvar>::iterator             iv;
79  string                             lo_line; 
80
81  for (ip=pline.begin(); ip != pline.end(); ip++) {
82    ip->global_substitute ("*"," *");
83    ip->global_substitute ("* *","**");
84    ip->global_substitute (","," , ");
85    ip->global_substitute ("/"," / ");
86    ip->global_substitute ("1:VL","j");
87  }
88  for (ip=pline.begin(); ip != pline.end(); ip++) {
89    for (iv=var_list.begin(); iv != var_list.end(); iv++) {
90      ip->change_variable_to_vector_g (*iv);
91    }
92  }
93
94  for (ip=pline.begin(); ip != pline.end(); ip++) {
95      if(kpp_switches.is_vector() ) {
96          ip->global_substitute ("phot (","phot(j,");
97      }
98  }
99
100  ip = pline.begin()+1 ;
101  lo_line = ip->get_line() ;
102  lo_line.erase();
103  if(kpp_switches.is_vector() ) {
104    lo_line = " INTEGER         :: j,k";
105  } else {
106    lo_line = " INTEGER         :: k";
107  }
108  ip->set_line(lo_line);
109 
110  if(kpp_switches.is_vector() ) {
111    ip = pline.begin()+2 ;
112    lo_line = ip->get_line() ;
113    lo_line.erase();
114    lo_line = " do k=1,vl";
115    ip->set_line(lo_line);
116
117    ip = pline.begin()+3 ;
118    lo_line = ip->get_line() ;
119    lo_line.erase();
120    lo_line = "  j = k";
121    ip->set_line(lo_line);
122
123    ip = pline.end()-2 ;
124    lo_line = ip->get_line() ;
125    lo_line.erase();
126    lo_line = " end do";
127    ip->set_line(lo_line);
128  } else {
129    ip = pline.begin()+3 ;
130    lo_line = ip->get_line() ;
131    lo_line.erase();
132    lo_line = "  k = is";
133    ip->set_line(lo_line);
134  }
135
136  return;
137}
138
139void fortran_file::edit_Initialize (vector <Vvar> &var_list) {
140  vector<program_line>::iterator     ip;
141  vector<Vvar>::iterator             iv;
142  string                             lo_line;
143
144  for (ip=pline.begin(); ip != pline.end(); ip++) {
145    ip->global_substitute ("*"," *");
146    ip->global_substitute ("* *","**");
147    ip->global_substitute (","," , ");
148    ip->global_substitute ("/"," / ");
149    ip->global_substitute ("1:VL","j");
150  }
151  for (ip=pline.begin(); ip != pline.end(); ip++) {
152    for (iv=var_list.begin(); iv != var_list.end(); iv++) {
153      ip->change_variable_to_vector_g (*iv);
154    }
155  }
156
157  for (ip=pline.begin(); ip != pline.end(); ip++) {
158    if(kpp_switches.is_vector() ) {
159          ip->global_substitute ("qvap","qvap(j)");
160    }
161  }
162  for (ip=pline.begin(); ip != pline.end(); ip++) {
163    if(kpp_switches.is_vector() ) {
164          ip->global_substitute ("fakt","fakt(j)");
165    }
166  }
167
168  ip = pline.begin()+3 ;
169  lo_line = ip->get_line() ;
170  lo_line.erase();
171  lo_line = "  INTEGER         :: j,k";
172  ip->set_line(lo_line);
173
174  if(kpp_switches.is_vector() ) {
175    ip = pline.begin()+9 ;
176    lo_line = ip->get_line() ;
177    lo_line.erase();
178    lo_line = " do k = is,ie";
179    ip->set_line(lo_line);
180
181    ip = pline.begin()+10 ;
182    lo_line = ip->get_line() ;
183    lo_line.erase();
184    lo_line = "  j = k - is +1";
185    ip->set_line(lo_line);
186
187    ip = pline.end()-2 ;
188    lo_line = ip->get_line() ;
189//  lo_line.erase();
190    lo_line = " end do";
191    ip->set_line(lo_line);
192  } else {
193    ip = pline.begin()+7 ;
194    lo_line = ip->get_line() ;
195    lo_line.erase();
196    lo_line = "  k = is";
197    ip->set_line(lo_line);
198  }
199
200  return;
201}
202
203
204void fortran_file::edit_KppDecomp () {
205
206  vector<program_line>::iterator     ip;
207  string                             lo_line;
208
209  bool declaration = true;
210
211  for (ip=pline.begin(); ip != pline.end(); ip++) {
212
213    if(ip->get_token(0) == "IER") {
214      declaration = false;
215    }
216    if ( declaration ) {
217      if(ip->get_token(0) == "REAL") {
218        lo_line = ip->get_line() ;
219        lo_line.erase();
220         if(kpp_switches.de_indexing () == 2) {
221           lo_line = "      REAL(kind=dp) :: JVS(:,:), a(VL)";
222         } else {
223           lo_line = "      REAL(kind=dp) :: JVS(:,:), W(VL,NVAR), a(VL)";
224         }
225        ip->set_line(lo_line);
226      }
227
228    } else {
229      ip->change_variable_to_vector ("W");
230      ip->change_variable_to_vector ("JVS");
231
232      if(ip->get_token(0) == "IF" || ip->get_token(1) == "IF") {
233        lo_line = ip->get_line() ;
234        lo_line.insert(0,"! Not in vector Mode ");
235        ip->set_line(lo_line);
236      }
237      if(ip->get_token(0) == "IER" && ip->get_token(2) == "k") {
238        lo_line = ip->get_line() ;
239        lo_line.insert(0,"! Not in vector Mode ");
240        ip->set_line(lo_line);
241      }
242      if(ip->get_token(0) == "RETURN") {
243        lo_line = ip->get_line() ;
244        lo_line.insert(0,"! Not in vector Mode ");
245        ip->set_line(lo_line);
246      }
247    }
248  }
249
250  return;
251}
252
253void fortran_file::edit_KppSolve () {
254
255  vector<program_line>::iterator     ip;
256
257  for (ip=pline.begin(); ip != pline.end(); ip++) {
258    if(ip->get_token(0) == "REAL") {
259      ip->substitute("NVAR",":,:");
260      ip->substitute("LU_NONZERO",":,:");
261    } else {
262      ip->change_variable_to_vector ("JVS");
263      ip->change_variable_to_vector ("X");
264    }
265  }
266
267  return;
268}
269
270void fortran_file::edit_Jac_SP () {
271
272  vector<program_line>::iterator     ip;
273  string                             lo_line;
274
275  for (ip=pline.begin(); ip != pline.end(); ip++) {
276    if(ip->get_token(0) == "REAL") {
277      ip->substitute("NVAR",":,:");
278      ip->substitute("NFIX",":,:");
279      ip->substitute("NREACT",":,:");
280      ip->substitute("LU_NONZERO",":,:");
281      if(ip->get_token(5) == "B") {
282        lo_line = ip->get_line() ;
283        lo_line.erase();
284        lo_line = " REAL(kind=dp) :: B(VL," +ip->get_token(7)  +")";
285        ip->set_line(lo_line);
286      }
287    } else {
288      ip->change_variable_to_vector ("V");
289      ip->change_variable_to_vector ("F");
290      ip->change_variable_to_vector ("B");
291      ip->change_variable_to_vector ("RCT");
292      ip->change_variable_to_vector ("JVS");
293    }
294  }
295
296  return;
297}
298
299void fortran_file::edit_Fun () {
300
301  vector<program_line>::iterator     ip;
302
303  bool declaration = true;
304
305  for (ip=pline.begin(); ip != pline.end(); ip++) {
306
307    if(ip->get_token(1) == "Computation" || ip->get_token(1) == "Told" ) {
308      declaration = false;
309    }
310    if ( declaration ) {
311      if(ip->get_token(0) == "REAL") {
312        ip->substitute("NVAR",":,:");
313        ip->substitute("NFIX",":,:");
314        ip->substitute("NREACT",":,:");
315      }
316    } else {
317      ip->change_variable_to_vector ("V");
318      ip->change_variable_to_vector ("F");
319      ip->change_variable_to_vector ("RCT");
320      ip->change_variable_to_vector ("Vdot");
321    }
322  }
323
324  return;
325}
326
327void fortran_file::edit_WAXPY () {
328
329  vector<program_line>::iterator     ip;
330
331  cout << "Handling subroutine: WAXPY" <<endl;
332
333  for (ip=pline.begin(); ip != pline.end(); ip++) {
334
335    if(ip->get_token(0) == "REAL") {
336       ip->substitute("N",":,:");
337       ip->substitute("N",":,:");
338       ip->substitute("Alpha","Alpha(:)");
339    } else {
340        ip->change_variable_to_vector ("Y");
341        ip->change_variable_to_vector ("X");
342        if(ip->get_token(0) != "SUBROUTINE") {
343                if(ip->get_token(0) == "IF")  {
344                        ip->substitute("Alpha","SUM(alpha(1:VL))");
345                } else {
346                        ip->substitute("Alpha","alpha(1:VL)");
347                }
348        }
349    }
350
351
352  }
353
354  return;
355}
356
357void fortran_file::edit_FunTemplate () {
358
359  vector<program_line>::iterator     ip;
360
361  cout << "Handling subroutine: FunTemplate" <<endl;
362
363  for (ip=pline.begin(); ip != pline.end(); ip++) {
364
365    if(ip->get_token(0) == "REAL") {
366       ip->substitute("NVAR",":,:");
367       ip->substitute("T,","T(:),");
368       ip->substitute("Told","Told(size(T)),Time(size(T))");
369    }
370
371
372  }
373
374  return;
375}
376
377void fortran_file::edit_JacTemplate () {
378
379  vector<program_line>::iterator     ip;
380
381  cout << "Handling subroutine: JacTemplate" <<endl;
382
383  for (ip=pline.begin(); ip != pline.end(); ip++) {
384
385    if(ip->get_token(0) == "REAL") {
386        ip->substitute("NVAR",":,:");
387        ip->substitute("T,","T(:),");
388        ip->substitute("Told","Told(size(T)),Time(size(T))");
389        ip->substitute("LU_NONZERO",":,:");
390    }
391
392
393  }
394
395  return;
396}
397
Note: See TracBrowser for help on using the repository browser.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |