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 @ 3298

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

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