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

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

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