Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

Ignore:
Timestamp:
Oct 2, 2018 12:21:11 PM (6 years ago)
Author:
kanani
Message:

Merge chemistry branch at r3297 to trunk

File:
1 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/fortran_file.C

    r2696 r3298  
    1313//Current revisions:
    1414//------------------
    15 //
    16 //
     15/
     16/
    1717//Former revisions:
    1818//-----------------
    1919//$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 $
    2030//
    2131//
    … …  
    2636//
    2737//
    28 // Nov 2016: Intial version (Klaus Ketelsen)
     38// Nov 2016: Intial version of KP4 adapted to PALM (Klaus Ketelsen)
    2939//
    3040
    … …  
    6272     }
    6373
    64 // Now do some cosmetics to adapt the KPP generated output a bit o the looks of PALM,
    65 // i.e. add some blanks, convert all to lowercase except Fortran language elements, etc.
    66        if(line.find("'",0) == string::npos)  {     // No substitution in line with strings
     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
    6794        if(line.substr(0,2) =="! ") {
    6895         global_substitute(line,"#","#");      // just a dummy so comments do not get lost
    … …  
    77104         global_substitute(line,"/JVS","/ JVS");
    78105         global_substitute(line,"-","- ");
    79          global_substitute(line,"e- ","e-");
    80106         global_substitute(line,"+","+ ");
    81107         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          global_substitute(line,")=",") =");
    88          global_subtolower(line);
    89          global_substitute(line,"call ","CALL ");
    90          global_substitute(line,"case","CASE");
    91          global_substitute(line,"character","CHARACTER");
    92          global_substitute(line,"contains","CONTAINS");
    93          global_substitute(line,"dimension","DIMENSION");
    94          global_substitute(line,"do ","DO ");
    95          global_substitute(line,"elseif","ELSEIF");
    96          global_substitute(line,"else","ELSE");
    97          global_substitute(line,"#ELSE","#else");
    98          global_substitute(line,"end do","ENDDO");
    99          global_substitute(line,"end if","ENDIF");
    100          global_substitute(line,"end ","END ");    // Modify "end" after all other strings containing "end..." are done!
    101          global_substitute(line,"#ENDIF","#endif");
    102          global_substitute(line,"function","FUNCTION");
    103          global_substitute(line,"if(","IF (");
    104          global_substitute(line," if "," IF ");
    105          global_substitute(line,"implicit","IMPLICIT");
    106          global_substitute(line,"include","INCLUDE");
    107          global_substitute(line,"intent","INTENT");
    108          global_substitute(line,"integer","INTEGER");
    109          global_substitute(line,"logical","LOGICAL");
    110          global_substitute(line,"module","MODULE");
    111          global_substitute(line,"none","NONE");
    112          global_substitute(line,"optional","OPTIONAL");
    113          global_substitute(line,"parameter","PARAMETER");
    114          global_substitute(line,"public","PUBLIC");
    115          global_substitute(line,"real","REAL");
    116          global_substitute(line,"return","RETURN");
    117          global_substitute(line,"use ","USE ");
    118          global_substitute(line,"save","SAVE");
    119          global_substitute(line,"subroutine","SUBROUTINE");
    120          global_substitute(line,"then","THEN");
    121          global_substitute(line,"while","WHILE");
    122        }
     108         }
    123109     }
    124110
    … …  
    167153//  Update_RCONST has only to be called once per outer timeloop in KPP_FOR_PALM
    168154
    169 //  if(ip->get_token(0) == "CALL" && ip->get_token(1) == "Update_RCONST" ) {
    170     if(ip->get_token(0) == "CALL" && ip->get_token(1) == "update_rconst" ) {
     155    if(ip->get_token(0) == "CALL" && ip->get_token(1) == "Update_RCONST" ) {
    171156      lo_line.insert(0,"!DELETE ");
    172157    cout << lo_line << endl;
    … …  
    175160//  Update_SUN must not be called within in KPP_FOR_PALM
    176161
    177 //  if(ip->get_token(0) == "CALL" && ip->get_token(1) == "Update_SUN" ) {
    178     if(ip->get_token(0) == "CALL" && ip->get_token(1) == "update_sun" ) {
     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") {
    179170      lo_line.insert(0,"!DELETE ");
    180171    cout << lo_line << endl;
    … …  
    338329    }
    339330
     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
    340420//  Make ind_ variables public
    341421    if(ip->get_token(3).substr(0,4) == "ind_") {
    … …  
    464544       to_do = false;
    465545    }
    466     if(ip->get_token(0).substr(0,1) != "!" && ip->get_token_number_from_string("temp") > 2) {
    467 //  if(ip->get_token(0).substr(0,1) != "!" && ip->get_token_number_from_string("XXXX") > 2) {
    468       todo_1 = true;
    469     }
     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
    470558    if(to_do || todo_1) {
    471559      if(ip->get_token(0).substr(0,1) == "!") continue;       // skip comment limes
    … …  
    499587      cout << "Vector variable " << ip->get_token(pos+1) <<" " << vari.nr_dim() <<endl;
    500588      lo_line = ip->get_line() ;
    501       if(vari.nr_dim() == 0) {
    502         lo_line.clear();
    503         lo_line = "  REAL(dp),dimension(:),allocatable             :: " + vari.name;
    504       }
    505       if(vari.nr_dim() == 1) {
    506         lo_line.clear();
    507         lo_line = "  REAL(dp),dimension(:,:),allocatable           :: " + vari.name;
    508       }
    509       if(vari.nr_dim() == 2) {
    510         lo_line.clear();
    511         lo_line = "  REAL(dp),dimension(:,:,:),allocatable         :: " + vari.name;
    512       }
    513       if(vari.nr_dim() == 3) {
    514         lo_line.clear();
    515         lo_line = "  REAL(dp),dimension(:,:,:,:),allocatable       :: " + vari.name;
     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         }
    516609      }
    517610      ip->set_line(lo_line);
    … …  
    541634
    542635  vector<program_line>::iterator     ip;
     636  program_line                    pl;
    543637  string                             lo_line;
     638  string                             line;
    544639
    545640  for (ip=pline.begin(); ip != pline.end(); ip++) {
    … …  
    555650    ip->global_substitute("* ","*");
    556651    ip->global_substitute("* ","*");
    557     ip->global_substitute("d- ","d-");
    558     ip->global_substitute("d+ ","d+");
     652//  ip->global_substitute("d- ","d-");
     653//  ip->global_substitute("d+ ","d+");
    559654    ip->global_substitute(", ",",");
    560655    ip->global_substitute(")=",") =");
    … …  
    562657    ip->global_substitute(", - ",", -");
    563658
     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
    564757//  line break if more than 130 character
    565758
    566     lo_line = ip->get_line();
     759//  lo_line = ip->get_line();
    567760    if( lo_line.size() < 130 ) {
    568       out << ip->get_line() <<endl;
     761//    out << ip->get_line() <<endl;
     762      out <<  lo_line    <<endl;
    569763    } else {
    570764      int cp  = lo_line.rfind("!",129);
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |