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.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: 25.5 KB
Line 
1
2// ############################################################################
3//
4//     create_mz_kpp_module                       
5//
6//     create scalar code from .f90 sources created by KPP to be used in MESSy
7//
8//     COPYRIGHT Klaus Ketelsen and MPI-CH   April 2007
9//
10// ############################################################################
11//
12//
13//Current revisions:
14//------------------
15/ 
16/ 
17//Former revisions:
18//-----------------
19//$Id: fortran_file.C 2470 2017-09-14 13:56:42Z forkel $
20//  ketelsen 18.09.2018: (Rev 3260) added vector switch and creation of dimension statement
21//  forkel Sept.2018:  'fill_' routine applied to qvap and fakt
22//                      removal of unnecessary variables (LOOKAT, monitor etc. from Fortran code)
23//  forkel June 2018:  Moved adaption to PALM conventions to the end of the process
24//                     in order to make future use of vector code adaptations possible
25//  forkel 20.04.2018: Replace Roundoff = WLAMCH('E') by Roundoff = epsilon(one)
26//
27//
28//
29/ 2017-09-14 13:56:42Z forkel $
30//
31//
32//changed KPP-generated code to lowercase with uppercase Fortran  expressions
33//added photolysis variables
34//
35//
36//
37//
38// Nov 2016: Intial version of KP4 adapted to PALM (Klaus Ketelsen)
39//
40
41
42#include <fstream>
43#include "fortran_file.h"
44
45#include "utils.h"
46#include "ctype.h"
47void fortran_file::read () {
48
49  ifstream                        in;
50  program_line                    pl;
51  string                          line;
52
53// Note: FORTRAN77 and include files are internally named .f90
54
55  string file_name = name + ".f90";
56  in.open(file_name.c_str() );
57  if( !in ) {
58    cout << "cannot open " << endl; my_abort(file_name);
59  }
60
61// Read kpp_fortran routines;
62  while ( 1 ) {
63     getline(in,line);
64     if( in.eof() ) break;
65     if( in.bad() ) my_abort("ERROR_READ_2");
66
67// Remove trailing blanks
68     while (1) {
69       if(line.size() < 100) break;
70       if(line.substr(line.size()-1,1) != " ")  break;
71       line.erase(line.size()-1,1);
72     }
73
74     if(line.find("'",0) == string::npos)  {     // No substitution in line with strings
75//     if(line.substr(0,4) !="!KPP") {
76//      global_substitute(line,"!"," ! ");
77//     if(line.substr(0,2) =="! ")   continue;           // No Substitute of Comments
78//     global_substitute(line,"("," ( ");
79//     global_substitute(line,")"," ) ");
80//     global_substitute(line,",",", ");
81//     global_substitute(line,"*","* ");
82//     global_substitute(line,"* *","**");
83//     global_substitute(line,"/JVS","/ JVS");
84//     global_substitute(line,"-","- ");
85//     global_substitute(line,"e- ","e-");
86//     global_substitute(line,"+","+ ");
87//     global_substitute(line,"d- ","d-");
88//     global_substitute(line,"D- ","D-");
89//     global_substitute(line,"e+ ","e+");
90//     global_substitute(line,"E+ ","E+");
91//     global_substitute(line,"E- ","E-");
92//      }
93
94        if(line.substr(0,2) =="! ") {
95         global_substitute(line,"#","#");      // just a dummy so comments do not get lost
96         } else {
97         global_substitute(line,"("," ( ");
98         global_substitute(line,")"," ) ");
99         global_substitute(line,",",", ");
100         global_substitute(line,",  ",", ");
101         global_substitute(line,")  ",") ");
102         global_substitute(line,"*","* ");
103         global_substitute(line,"* *","**");
104         global_substitute(line,"/JVS","/ JVS");
105         global_substitute(line,"-","- ");
106         global_substitute(line,"+","+ ");
107         global_substitute(line,"+  ","+ ");
108         }
109     }
110
111     pl.set_line(line);
112     pline.push_back(pl);
113   }
114   in.close();
115
116  return;
117}
118void fortran_file::edit_fortran () {
119
120  vector<program_line>::iterator     ip;
121  string                             lo_line;
122  bool                               deleted;
123
124  for (ip=pline.begin(); ip != pline.end(); ip++) {
125    if(ip->get_token(0) =="!")   continue;           // No editing of Comments
126    deleted = false;
127    lo_line = ip->get_line() ;
128    if(ip->get_token(0) == "MODULE" && ip->get_token_size() >= 1) {
129      lo_line.insert(0,"!DELETE ");
130    }
131    if(ip->get_token(0) == "USE" && ip->get_token_size() >= 1) {
132      deleted = true;
133      lo_line.insert(0,"!DELETE ");
134    }
135    if(ip->get_token(0) == "PUBLIC" && ip->get_token_size() >= 1) {
136      deleted = true;
137      lo_line.insert(0,"!DELETE ");
138    }
139//    if(ip->get_token(0) == "SAVE" && ip->get_token_size() >= 1) {
140//      lo_line.insert(0,"!DELETE ");
141//    }
142
143//  Only IMPLICIT none, not IMPLICIT REAL (A-H,O-Z)
144    if(ip->get_token(0) == "IMPLICIT" && ip->get_token_size() == 2) {
145      lo_line.insert(0,"!DELETE ");
146    }
147
148//  Delete INCLUDE lines
149    if(ip->get_token(0) == "INCLUDE" && ip->get_token_size() >= 1) {
150      lo_line.insert(0,"!DELETE ");
151    }
152
153//  Update_RCONST has only to be called once per outer timeloop in KPP_FOR_PALM
154
155    if(ip->get_token(0) == "CALL" && ip->get_token(1) == "Update_RCONST" ) {
156      lo_line.insert(0,"!DELETE ");
157    cout << lo_line << endl;
158    }
159
160//  Update_SUN must not be called within in KPP_FOR_PALM
161
162    if(ip->get_token(0) == "CALL" && ip->get_token(1) == "Update_SUN" ) {
163      lo_line.insert(0,"!DELETE ");
164    cout << lo_line << endl;
165    }
166
167//  Remove "    var(i) = x"  (Make sure  that var does not occur as first token anywhere else)
168
169    if(ip->get_token(0) == "VAR") {
170      lo_line.insert(0,"!DELETE ");
171    cout << lo_line << endl;
172    }
173
174
175    ip->set_line(lo_line);
176
177//  Delete continuation lines
178
179    if(deleted) {
180      while( ip->get_token_number_from_string("&") > 1) {
181        ip++;
182        lo_line = ip->get_line() ;
183        lo_line.insert(0,"!DELETE ");
184        ip->set_line(lo_line);
185      }
186    }
187  }
188
189  return;
190}
191
192void fortran_file::copy_to_subroutine_vector (vector<fortran_file> &subvec, 
193                                                         fortran_file & header_var) {
194  vector<program_line>::iterator     ip;
195  vector<fortran_file>::iterator     iv;
196  bool                               active_subroutine;
197  string                             active_name;
198  int                                name_pos;
199
200// loop over all lines in a fortran file
201
202
203// First, copy Module variables into header_var
204// This variables wil later copied into the kpp-moduzle header
205
206  for (ip=pline.begin(); ip != pline.end(); ip++) {
207    if(ip->get_token(0) == "CONTAINS")   break;          // Header done
208
209//  Special Treatment of defining variables in PARAMETER context
210//  The intel compiler creates fatal error, if blanks are embedded between / /
211//  The SX-6 Compiler gives a warning
212
213    ip->substitute("( / &","(/&");
214    ip->substitute(",  & !",",& !");
215    ip->substitute(" / )","/)");
216
217
218    header_var.add_line(ip->get_line());
219  }
220
221//  look for SUBROUTINE statement
222  active_subroutine = false;
223
224  for (ip=pline.begin(); ip != pline.end(); ip++) {
225
226//  look for SUBROUTINE statement
227    if(ip->get_token(0) == "SUBROUTINE" && !active_subroutine) {
228
229      for(iv=subvec.begin();iv!=subvec.end();iv++) {
230        if(ip->get_token(1) == iv->get_name() ) { 
231//        Subroutine is in list
232          active_subroutine = true;
233          active_name = ip->get_token(1);
234          cout << "SUBROUTINE: " << active_name << " found in file " << name << endl;
235          break;
236        }
237      }
238    }
239
240//  look for FUNCTION statement
241    name_pos = ip->get_token_number_from_string("FUNCTION");
242    if(name_pos != -1 && !active_subroutine) {
243      name_pos++;
244      for(iv=subvec.begin();iv!=subvec.end();iv++) {
245        if(ip->get_token(name_pos) == iv->get_name() ) { 
246//        Subroutine is in list
247          active_subroutine = true;
248          active_name = ip->get_token(name_pos);
249          cout << "FUNCTION  : " << active_name << " found in file " << name << endl;
250          break;
251        }
252      }
253    }
254
255    if(active_subroutine)  {
256//    copy FORTRAN line from file to subroutine
257      iv->add_line(ip->get_line());
258    }
259    if(ip->get_token(1) == "SUBROUTINE" && ip->get_token(2) == active_name) {
260      cout << "SUBROUTINE: " << active_name << " done " << endl;
261      active_subroutine = false;
262      active_name = " ";
263    }
264    if(ip->get_token(1) == "FUNCTION" && ip->get_token(2) == active_name) {
265      cout << "FUNCTION  : " << active_name << " done " << endl;
266      active_subroutine = false;
267      active_name = " ";
268    }
269  }
270
271  return;
272}
273
274void fortran_file::edit_FUNC () {
275
276  vector<program_line>::iterator     ip;
277  string                             lo_line;
278
279  for (ip=pline.begin(); ip != pline.end(); ip++) {
280    ip->substitute("REAL*8   Y(NVAR), J(LU_NONZERO)","real (kind=8),dimension(:,:)  :: y,j");
281    ip->substitute("REAL*8   Y(NVAR), P(NVAR)",      "real (kind=8),dimension(:,:)  :: y,p");
282    lo_line = ip->get_line() ;
283    if(ip->get_token(0) == "Told" && ip->get_token(1) == "=") {
284      lo_line.insert(0,"!DELETE ");
285    }
286    if(ip->get_token(0) == "TIME" && ip->get_token(1) == "=") {
287      lo_line.insert(0,"!DELETE ");
288    }
289    ip->set_line(lo_line);
290  }
291
292  return;
293}
294
295void fortran_file::edit_inc (fortran_file & header_var) {
296
297  vector<program_line>::iterator     ip;
298  string                             lo_line;
299  string                             lo_line_2;
300  string                             lo_line_3;
301  bool                               deleted;
302  int                                i,nr_var;
303  string                             public_line;
304
305// Delete module and end module lines
306
307  header_var.add_line("! Automatic generated PUBLIC Statements for ip_ and ihs_ variables ");
308  header_var.add_line(" ");
309
310  for (ip=pline.begin(); ip != pline.end(); ip++) {
311    deleted = false;
312    lo_line = ip->get_line() ;
313    if(ip->get_token(0) == "MODULE" && ip->get_token_size() >= 1) {
314      lo_line.insert(0,"!DELETE ");
315    }
316    if(ip->get_token(0) == "END" && ip->get_token_size() >= 1) {
317      lo_line.insert(0,"!DELETE ");
318    }
319    if(ip->get_token(0) == "USE" && ip->get_token_size() >= 1) {
320      deleted = true;
321      lo_line.insert(0,"!DELETE ");
322    }
323    if(ip->get_token(0) == "PUBLIC" && ip->get_token_size() >= 1) {
324      deleted = true;
325      lo_line.insert(0,"!DELETE ");
326    }
327    if(ip->get_token(0) == "SAVE" && ip->get_token_size() >= 1) {
328      lo_line.insert(0,"!DELETE ");
329    }
330
331//  Remove  REAL(kind=dp):: sun
332
333    if(ip->get_token_number_from_string("SUN") > 0) {
334      lo_line.insert(0,"!DELETE ");
335    cout << lo_line << endl;
336    }
337
338//  Remove    INTEGER :: ddmtype
339
340    if(ip->get_token_number_from_string("DDMTYPE") > 0) {
341    cout << lo_line << endl;
342      lo_line.insert(0,"!DELETE ");
343    cout << lo_line << endl;
344    }
345
346//  Remove    REAL(kind=dp) :: dt
347
348    if(ip->get_token_number_from_string("DT") > 0) {
349    cout << lo_line << endl;
350      lo_line.insert(0,"!DELETE ");
351    cout << lo_line << endl;
352    }
353
354//  Remove    LOOKAT
355
356    if(ip->get_token_number_from_string("LOOKAT") > 0) {
357    cout << lo_line << endl;
358      lo_line.insert(0,"!DELETE ");
359    cout << lo_line << endl;
360    }
361
362//  Remove    NLOOKAT
363
364    if(ip->get_token_number_from_string("NLOOKAT") > 0) {
365    cout << lo_line << endl;
366      lo_line.insert(0,"!DELETE ");
367    cout << lo_line << endl;
368    }
369
370//  Remove    MONITOR
371
372    if(ip->get_token_number_from_string("MONITOR") > 0) {
373    cout << lo_line << endl;
374      lo_line.insert(0,"!DELETE ");
375    cout << lo_line << endl;
376    }
377
378//  Remove    NMONITOR
379
380    if(ip->get_token_number_from_string("NMONITOR") > 0) {
381    cout << lo_line << endl;
382      lo_line.insert(0,"!DELETE ");
383    cout << lo_line << endl;
384    }
385
386//  Remove    SMASS
387
388    if(ip->get_token_number_from_string("SMASS") > 0) {
389    cout << lo_line << endl;
390      lo_line.insert(0,"!DELETE ");
391    cout << lo_line << endl;
392    }
393
394//  Remove    RTOLS
395
396    if(ip->get_token_number_from_string("RTOLS") > 0) {
397    cout << lo_line << endl;
398      lo_line.insert(0,"!DELETE ");
399    cout << lo_line << endl;
400    }
401
402//  Remove    TEND
403
404    if(ip->get_token_number_from_string("TEND") > 0) {
405    cout << lo_line << endl;
406      lo_line.insert(0,"!DELETE ");
407    cout << lo_line << endl;
408    }
409
410//  Remove    STEPMAX
411
412    if(ip->get_token_number_from_string("STEPMAX") > 0) {
413    cout << lo_line << endl;
414      lo_line.insert(0,"!DELETE ");
415    cout << lo_line << endl;
416    }
417
418
419
420//  Make ind_ variables public
421    if(ip->get_token(3).substr(0,4) == "ind_") {
422      global_substitute (lo_line,"PARAMETER","PARAMETER, PUBLIC");
423    }
424 
425// Make ip_ variables public
426
427//  mz_rs_20070907+
428// ip_* are already public
429// Make ip_ variables public
430//     nr_var=0;
431//     for(i=0;i<ip->get_token_size();i++) {
432//       if(ip->get_token(i).substr(0,3) == "ip_" && ip->get_token(0).substr(0,1) != "!") {
433//         nr_var++;
434//         if(nr_var == 1)  {
435//           public_line.clear();
436//           public_line = "  PUBLIC  " + ip->get_token(i);
437
438//         } else {
439//           public_line += ", " + ip->get_token(i);
440//         }
441//       }
442//     }
443//     if(nr_var > 0) {
444//       header_var.add_line(public_line);
445//     }
446//  mz_rs_20070907-
447
448// Make ihs_ variables public
449
450    nr_var=0;
451    for(i=0;i<ip->get_token_size();i++) {
452      if(ip->get_token(i).substr(0,4) == "ihs_" && ip->get_token(0).substr(0,1) != "!") {
453        nr_var++;
454        if(nr_var == 1)  {
455          public_line.clear();
456          public_line = "  PUBLIC  " + ip->get_token(i);
457
458        } else {
459          public_line += ", " + ip->get_token(i);
460        }
461      }
462    }
463    if(nr_var > 0) {
464      header_var.add_line(public_line);
465    }
466
467    ip->set_line(lo_line);
468
469//  Delete continuation lines
470
471    if(deleted) {
472      while( ip->get_token_number_from_string("&") > 1) {
473        ip++;
474        lo_line = ip->get_line() ;
475        lo_line.insert(0,"!DELETE ");
476        ip->set_line(lo_line);
477      }
478    }
479  }
480
481  for (ip=pline.begin(); ip != pline.end(); ip++) {
482//  Special Treatment of defining variables in PARAMETER context
483//  The intel compiler creates fatal error, if blanks are embedded between / /
484//  The SX-6 Compiler gives a warning
485
486    if(ip->get_token(7) == "substep" && ip->get_token(9) == "nsubsteps") {
487      ip->substitute("( / 0. / )","0.0");
488    }
489    ip->substitute("( /","(/");
490    ip->substitute("/ )","/)");
491  }
492
493  return;
494}
495
496void fortran_file::create_species_list(vector <string> &species_list) {
497  vector<program_line>::iterator     ip;
498  string                             lo_line;
499  string                             specname;
500  string                             longname;
501
502  bool to_do = false;
503
504  for (ip=pline.begin(); ip != pline.end(); ip++) {
505    if(ip->get_token(2) == "declaration" && ip->get_token(5) == "species") {
506      to_do = true;
507    }
508    if(ip->get_token(5) == "0" && ip->get_token_size() > 5 ) {
509       to_do = false;
510    }
511    if(ip->get_token(0) == "INTEGER," && to_do) {
512      lo_line = ip->get_line() ;
513      int pos = lo_line.find("ind_",0);
514      int end = lo_line.find(" ",pos+1);
515      if(pos > 1) {
516        specname.clear();
517        longname.clear();
518        specname = lo_line.substr(pos+4,end-pos-4);
519        longname = specname + "                 ";
520        //        if(specname != "H2O")  {                     // NO idt_variable for H2O
521          species_list.push_back(specname);
522        //}
523      }
524    }
525  }
526
527  return;
528}
529
530void fortran_file::vector_variable_list(vector <Vvar> &var_list) {
531  vector<program_line>::iterator     ip;
532  string                             lo_line;
533  Vvar                               vari;
534  bool                               todo_1;
535
536  bool to_do = false;
537  for (ip=pline.begin(); ip != pline.end(); ip++) {
538    todo_1 = false;
539    if(ip->get_token(0) == "!KPPPP_DIRECTIVE" && ip->get_token(4) == "start") {
540      to_do = true;
541      ip++;
542    }
543    if(ip->get_token(0) == "!KPPPP_DIRECTIVE" && ip->get_token(4) == "end") {
544       to_do = false;
545    }
546    if(kpp_switches.is_vector()) {
547       if(ip->get_token(0).substr(0,1) != "!" && ip->get_token_number_from_string("TEMP") > 2) {
548         todo_1 = true;
549       }
550       if(ip->get_token(0).substr(0,1) != "!" && ip->get_token_number_from_string("QVAP") > 2) {
551         todo_1 = true;
552       }
553       if(ip->get_token(0).substr(0,1) != "!" && ip->get_token_number_from_string("FAKT") > 2) {
554         todo_1 = true;
555       }
556    }
557
558    if(to_do || todo_1) {
559      if(ip->get_token(0).substr(0,1) == "!") continue;       // skip comment limes
560      vari.clear();
561      int pos1 = ip->get_token_number_from_string_upper ("DimensioN");
562      int pos  = ip->get_token_number_from_string("::");
563      vari.name = ip->get_token(pos+1);
564      if(pos1 > 1) {
565        for (int i=pos1+2; i< ip->get_token_size(); i++) {
566          if(ip->get_token(i).substr(0,1) == "!" || ip->get_token(i) == ")" ) {
567            break;
568          } else {
569            ip->substitute(","," "); 
570            vari.dim_var.push_back(ip->get_token(i));
571          }
572        }
573      } else {
574        if(ip->get_token_size() > pos+1 && ip->get_token(pos+2).substr(0,1) != "!" 
575                          && ip->get_token(pos+2).substr(0,1) != "=" )  {
576          for (int i=pos+3; i< ip->get_token_size(); i++) {
577            if(ip->get_token(i).substr(0,1) == "!" || ip->get_token(i) == ")" ) {
578              break;
579            } else {
580              ip->substitute(","," "); 
581              vari.dim_var.push_back(ip->get_token(i));
582            }
583          }
584        }
585      }
586      var_list.push_back(vari);
587      cout << "Vector variable " << ip->get_token(pos+1) <<" " << vari.nr_dim() <<endl;
588      lo_line = ip->get_line() ;
589      if(todo_1)   {
590          lo_line.clear();
591          lo_line = "  REAL(dp),dimension(VL_DIM)                  :: " + vari.name;
592      } else {
593         if(vari.nr_dim() == 0) {
594           lo_line.clear();
595           lo_line = "  REAL(dp),dimension(:),allocatable             :: " + vari.name;
596         }
597         if(vari.nr_dim() == 1) {
598           lo_line.clear();
599           lo_line = "  REAL(dp),dimension(:,:),allocatable           :: " + vari.name;
600         }
601         if(vari.nr_dim() == 2) {
602           lo_line.clear();
603           lo_line = "  REAL(dp),dimension(:,:,:),allocatable         :: " + vari.name;
604         }
605         if(vari.nr_dim() == 3) {
606           lo_line.clear();
607           lo_line = "  REAL(dp),dimension(:,:,:,:),allocatable       :: " + vari.name;
608         }
609      }
610      ip->set_line(lo_line);
611    }
612  }
613
614  return;
615}
616
617void fortran_file::print () {
618
619  vector<program_line>::iterator     ip;
620
621  cout << " " <<endl;
622  cout << "FORTRAN file " << name << endl;
623
624  for (ip=pline.begin(); ip != pline.end(); ip++) {
625    cout << ip->get_line() <<endl;
626  }
627
628  cout << " " <<endl;
629
630  return;
631}
632
633void fortran_file::write_file (ofstream & out) {
634
635  vector<program_line>::iterator     ip;
636  program_line                    pl;
637  string                             lo_line;
638  string                             line;
639
640  for (ip=pline.begin(); ip != pline.end(); ip++) {
641    ip->global_substitute(" ( ","(");
642    ip->global_substitute(" ) ",")");
643    ip->global_substitute(" )",")");
644    ip->global_substitute("A (","A(");
645    ip->global_substitute("B (","B(");
646    ip->global_substitute("V (","V(");
647    ip->global_substitute("Vdot (","Vdot(");
648    ip->global_substitute("JVS (","JVS(");
649    ip->global_substitute("RCT (","RCT(");
650    ip->global_substitute("* ","*");
651    ip->global_substitute("* ","*");
652//  ip->global_substitute("d- ","d-");
653//  ip->global_substitute("d+ ","d+");
654    ip->global_substitute(", ",",");
655    ip->global_substitute(")=",") =");
656    ip->global_substitute("dp,","dp, ");
657    ip->global_substitute(", - ",", -");
658
659// Now do some cosmetics to adapt the KPP generated output a bit o the looks of PALM,
660// i.e. add some blanks, convert all to lowercase except Fortran language elements, etc.
661//  Replace Roundoff = WLAMCH('E') by Roundoff = epsilon(one)
662       ip->global_substitute("Roundoff = WLAMCH('E')","roundoff = epsilon(one)");
663       lo_line = ip->get_line();
664       if(lo_line.find("'",0) == string::npos)  {     // No substitution in line with strings
665        if(lo_line.substr(0,2) =="! ") {
666         ip->global_substitute("#","#");      // just a dummy so comments do not get lost
667         } else {
668//       cout << "HIER0 " << lo_line <<endl;
669//       global_substitute(lo_line,"("," ( ");
670//       global_substitute(lo_line,")"," ) ");
671         global_substitute(lo_line,",",", ");
672         global_substitute(lo_line,",  ",", ");
673         global_substitute(lo_line,")  ",") ");
674         global_substitute(lo_line,"*","* ");
675         global_substitute(lo_line,"* *","**");
676         global_substitute(lo_line,")+",") +");
677         global_substitute(lo_line,")-",") -");
678         global_substitute(lo_line,")/",") /");
679         global_substitute(lo_line,")*",") *");
680         global_substitute(lo_line,")=",") =");
681//       global_substitute(lo_line,"-","- ");
682         global_substitute(lo_line,"-  ","- ");
683         global_substitute(lo_line,"+","+ ");
684         global_substitute(lo_line,"+  ","+ ");
685         global_substitute(lo_line,"=- ","= -");
686         global_substitute(lo_line,"/JVS","/ JVS");
687         global_substitute(lo_line,"d- ","d-");
688         global_substitute(lo_line,"d+ ","d+");
689         global_substitute(lo_line,"D- ","D-");
690         global_substitute(lo_line,"D+ ","D+");
691         global_substitute(lo_line,"e- ","e-");
692         global_substitute(lo_line,"e+ ","e+");
693         global_substitute(lo_line,"E+ ","E+");
694         global_substitute(lo_line,"E- ","E-");
695         ip->global_subtolower(lo_line);
696         global_substitute(lo_line,"allocated","ALLOCATED");
697         global_substitute(lo_line,"allocatable","ALLOCATABLE");
698         global_substitute(lo_line,".and. ",".AND. ");
699         global_substitute(lo_line,"call ","CALL ");
700         global_substitute(lo_line,"case","CASE");
701         global_substitute(lo_line,"character","CHARACTER");
702         global_substitute(lo_line,"contains","CONTAINS");
703         global_substitute(lo_line,"deallocate","DEALLOCATE");
704         global_substitute(lo_line,"allocate","ALLOCATE");
705         global_substitute(lo_line,"dimension","DIMENSION");
706         global_substitute(lo_line,"do ","DO ");
707         global_substitute(lo_line,"elseif","ELSEIF");
708         global_substitute(lo_line,"else","ELSE");
709         global_substitute(lo_line,"#ELSE","#else");
710         global_substitute(lo_line,"end do","ENDDO");
711         global_substitute(lo_line,"end if","ENDIF");
712         global_substitute(lo_line,"endif","ENDIF");
713         global_substitute(lo_line,"endwhere","ENDWHERE");
714         global_substitute(lo_line,"end ","END ");    // Modify "end" after all other strings containing "end..." are done!
715         global_substitute(lo_line,"tEND","tend");
716         global_substitute(lo_line,"#ENDIF","#endif");
717         global_substitute(lo_line,"equivalence","EQUIVALENCE");
718         global_substitute(lo_line,"function","FUNCTION");
719         global_substitute(lo_line,"if(","IF (");
720         global_substitute(lo_line," if "," IF ");
721         global_substitute(lo_line,"implicit","IMPLICIT");
722         global_substitute(lo_line,"include","INCLUDE");
723         global_substitute(lo_line,"intent","INTENT");
724         global_substitute(lo_line,"integer","INTEGER");
725         global_substitute(lo_line,"interface","INTERFACE");
726         global_substitute(lo_line,"logical","LOGICAL");
727         global_substitute(lo_line,"module","MODULE");
728         global_substitute(lo_line,"none","NONE");
729         global_substitute(lo_line,"only","ONLY");
730         global_substitute(lo_line,"optional","OPTIONAL");
731         global_substitute(lo_line,"parameter","PARAMETER");
732         global_substitute(lo_line,"present","PRESENT");
733         global_substitute(lo_line,"private","PRIVATE");
734         global_substitute(lo_line,"procedure","PROCEDURE");
735         global_substitute(lo_line,"public","PUBLIC");
736         global_substitute(lo_line,"real","REAL");
737         global_substitute(lo_line,"return","RETURN");
738         global_substitute(lo_line,"use ","USE ");
739         global_substitute(lo_line,"save","SAVE");
740         global_substitute(lo_line,"subroutine","SUBROUTINE");
741         global_substitute(lo_line,"then","THEN");
742         global_substitute(lo_line,"where","WHERE");
743         global_substitute(lo_line,"while","WHILE");
744         global_substitute(lo_line,".false.",".FALSE.");
745         global_substitute(lo_line,".true.",".TRUE.");
746         global_substitute(lo_line,"(in)","(IN)");
747         global_substitute(lo_line,"(out)","(OUT)");
748         global_substitute(lo_line,"(inout)","(INOUT)");
749         global_substitute(lo_line,"\t","      ");
750//       cout << "HIER1 " << lo_line <<endl;
751       }
752     }
753//   pl.set_line(lo_line);
754//   pline.push_back(pl);
755
756
757//  line break if more than 130 character
758
759//  lo_line = ip->get_line();
760    if( lo_line.size() < 130 ) {
761//    out << ip->get_line() <<endl;
762      out <<  lo_line    <<endl;
763    } else {
764      int cp  = lo_line.rfind("!",129);
765      int pos = lo_line.rfind(" ",129);
766      out << lo_line.substr(0,pos) << " &"<<endl;
767      lo_line.erase (0,pos);
768      if(ip->get_token (0).substr(0,1)  == "!" || cp != string::npos ) {
769        out << "!   " << lo_line   <<endl;                 // comment also in next line
770      } else {
771        out << "                    " << lo_line   <<endl;
772      }
773    }
774  }
775
776  out << " " <<endl;
777
778  return;
779}
780
781void fortran_file::copy_to_MZ_KPP (fortran_file & ka) {
782
783  vector<program_line>::iterator     ip;
784
785  for (ip=pline.begin(); ip != pline.end(); ip++) {
786//  Do not copy lines marked for delete
787    if(ip->get_token(0) != "!DELETE") {
788      ka.add_line( ip->get_line() );
789    }
790  }
791
792  return;
793}
794void  fortran_file::global_substitute(string &line, string old_s, string new_s) {
795   int         pos;
796
797   int start = line.size()-1;
798
799   while (1) {
800     pos = line.rfind (old_s, start);       // look for string
801
802     if (pos == string::npos) {
803       break;
804     }
805
806     line.replace(pos,old_s.size(),new_s);
807
808     start = pos-1;
809   }
810
811   return;
812}
813
814void  fortran_file::global_subtolower(string &line) {
815
816   int start = line.size()-1;
817   char c;
818
819    int i = 0;
820    while (line[i])
821    {
822      c = line[i];
823      line[i] = tolower(c);
824      i++;
825    }
826   return;
827}
Note: See TracBrowser for help on using the repository browser.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |