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

Last change on this file since 3799 was 3789, checked in by forkel, 6 years ago

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