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

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

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