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

Merge chemistry branch at r3297 to trunk

Location:
palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src
Files:
9 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/create_kpp_module.C

    r2768 r3298  
    1717//-----------------
    1818//$Id: create_kpp_module.C 2470 2017-09-14 13:56:42Z forkel $
     19// forkel 25.09.2018:  added  automatic line with meechanism name (read mech_list)
     20// forkel 20.09.2018:  added  vl_glo = size(tempi,1)
     21// ketelsen 18.09.2018: Removed creation of fill_ Subroutine and creation of calls thereof
     22//
     23// forkel 12.09.2018: Fix in order not to loose the values of qvap and fakt
     24//
     25// forkel 03.09.2018: Bug fix: moved kppi.add_line("    CALL initialize after fakt = fakti(is)
     26// forkel June 2018: added qvap and fakt, re-established original uppercase/lowercase
     27//                    Deleted definition of qvap,fakt in create_kpp_integrate again
     28//
     29// ketelsen July 2018: Changes for vector mode (edit_WAXPY, edit_FunTemplate, edit_JacTemplate,
     30//                            some cleanup of comments, various changes in create_kpp_integrate)
     31//
     32// forkel June 2018: Added qvap and fakt, re-established original uppercase/lowercase
     33//
     34//
     35/ 2017-09-14 13:56:42Z forkel $
    1936// Removed preprocessor directive __chem again
    2037//
    21 / 2017-09-14 13:56:42Z forkel $
     38// 2017-09-14 13:56:42Z forkel $
    2239//
    2340//
     
    2542//change of some output to lowercase with uppercase Fortran
    2643//
    27 // Nov 2016: Intial version (Klaus Ketelsen)
     44// Nov 2016: Intial version of KP4 adapted to PALM (Klaus Ketelsen)
    2845//
    2946
     
    4966   cout << "Create " << module_name << " from kpp Fortran sources" <<endl;
    5067   cout << "Vector mode " << kpp_switches.is_vector() <<endl;
     68   cout << "De_indexing " << kpp_switches.de_indexing() <<endl;
    5169
    5270   create_fortran_files_and_read();
    53    cout << "## after create_fortran_files_and_read " <<endl;
    5471
    5572// Generate first module lines
    5673
    5774     string first_line="MODULE " + module_name;
    58      mz_kpp.add_line(first_line);
    59      mz_kpp.add_line("!");
    60 //   mz_kpp.add_line("#if defined( __chem )");
    61 //   mz_kpp.add_line(" ");
     75   mz_kpp.add_line(first_line);
     76   mz_kpp.add_line(" ");
    6277
    6378//    string e5_line = first_line +"_e5";
     
    93108     it->edit_fortran ();
    94109   }
    95    cout << "## after edit FORTRAN files            " <<endl;
    96110
    97111// Generate a list of single subroutines from kpp-files
     
    109123   }
    110124
    111 
    112    if(kpp_switches.is_vector()) {
    113 
     125   if(kpp_switches.is_vector()) {
     126
     127   cout << "##### Hier kpp_switches.is_vector          " <<endl;
    114128//   Change header section
    115129     for(it=kpp_includes.begin();it!=kpp_includes.end();it++) {
     
    138152         it->edit_Fun();
    139153       }
    140      }
    141    cout << "## after Edit individual subroutines    " <<endl;
     154       if(it->get_name() == "WAXPY" ) {
     155         it->edit_WAXPY();
     156       }
     157       if(it->get_name() == "FunTemplate" ) {
     158         it->edit_FunTemplate();
     159       }
     160       if(it->get_name() == "JacTemplate" ) {
     161         it->edit_JacTemplate();
     162       }
     163     }
     164// cout << "## after Edit individual subroutines    " <<endl;
    142165
    143166   }
     
    146169
    147170   for(it=kpp_subroutines.begin();it!=kpp_subroutines.end();it++) {
    148      if(it->get_name() == "update_rconst") {
     171     if(it->get_name() == "Update_RCONST") {
    149172       it->edit_Update_RCONST(Vvar_list);
    150173     }
     174
     175     if(it->get_name() == "Initialize") {
     176       it->edit_Initialize(Vvar_list);
     177     }
     178
    151179   }
    152180
     
    184212     }
    185213
    186      buf = prefix + "INTERFACE            " + it->get_name() ;
     214     buf = prefix + "interface            " + it->get_name() ;
    187215     mz_kpp.add_line(buf);
    188      buf = prefix + "  MODULE PROCEDURE   " + it->get_name();
     216     buf = prefix + "  module procedure   " + it->get_name();
    189217     mz_kpp.add_line(buf);
    190      buf = prefix + "END INTERFACE        " + it->get_name();
     218     buf = prefix + "end interface        " + it->get_name();
    191219     mz_kpp.add_line(buf);
    192220     mz_kpp.add_line(" ");
    193221   }
    194    for(iv=Vvar_list.begin();iv!=Vvar_list.end();iv++) {
    195      string          buf;
    196 
    197      string sub_name = "fill_" + iv->name;
    198      buf = "  INTERFACE            " + sub_name;
    199      mz_kpp.add_line(buf);
    200      buf = "    MODULE PROCEDURE   " + sub_name;
    201      mz_kpp.add_line(buf);
    202      buf = "  END INTERFACE        " + sub_name;
    203      mz_kpp.add_line(buf);
    204      buf = "  PUBLIC               " + sub_name;
    205      mz_kpp.add_line(buf);
    206      mz_kpp.add_line(" ");
    207    }
    208222
    209223   mz_kpp.add_line(" ");
    210224
    211    for(iv=Vvar_list.begin();iv!=Vvar_list.end();iv++) {
    212      create_fill_routine(kpp_subroutines, *iv);
    213    }
    214225
    215226// Copy FORTRAN subroutines to mz_kpp
     
    224235// Finish module
    225236
    226 //   mz_kpp.add_line("#endif");
    227      string last_line="END MODULE " + module_name;
    228      mz_kpp.add_line("");
    229      mz_kpp.add_line(last_line);
    230 
    231 // Handle e5 module
    232 
    233 //    for(it=e5_subroutines.begin();it!=e5_subroutines.end();it++) {
    234 //      e5_kpp.add_line(" ");
    235 //      it->copy_to_MZ_KPP(e5_kpp);
    236 //    }
    237 
    238 //    last_line = last_line + "_e5";
    239 //    e5_kpp.add_line(" ");
    240 //    e5_kpp.add_line(last_line);
     237   string last_line="end module " + module_name;
     238   mz_kpp.add_line("");
     239   mz_kpp.add_line(last_line);
    241240
    242241// Write the complete module to file: mz_kpp.f
     
    376375   string                          diline;
    377376
     377// Read mechanism from mech_list
     378
     379   in.open("mech_list");
     380   if( !in ) {
     381      cout << "cannot open " << endl; my_abort("mech_list");
     382   }
     383
     384   while ( 1 ) {
     385     getline (in, buf);
     386     if( in.eof() ) break;
     387     if( in.bad() ) my_abort("ERROR_READ_4");
     388     line.set_line(buf);
     389     mz_kpp.add_line(line);
     390   }
     391   in.close();
     392
     393
    378394// Read Modul Header from file $MZ_KPP_HOME/templates/module_header
    379395
     
    394410   mz_kpp.add_line("                                                                 ");
    395411   if(kpp_switches.is_vector()) {
    396        mz_kpp.add_line("  LOGICAL,  PARAMETER          :: l_vector = .TRUE.             ");
    397    } else {
    398        mz_kpp.add_line("  LOGICAL,  PARAMETER          :: l_vector = .FALSE.            ");
     412       mz_kpp.add_line("  logical,parameter          :: L_VECTOR = .TRUE.             ");
     413   } else {
     414       mz_kpp.add_line("  logical,parameter          :: L_VECTOR = .FALSE.            ");
    399415   }
    400416//  mz_pj_20070531+
    401417   sprintf(distr,"%i",kpp_switches.de_indexing());
    402418   diline = distr ;
    403    mz_kpp.add_line("  INTEGER,  PARAMETER          :: i_lu_di = " + diline );
     419   mz_kpp.add_line("  integer,parameter          :: I_LU_DI = " + diline );
    404420//  mz_pj_20070531-
    405421
    406    mz_kpp.add_line("  INTEGER,  PARAMETER          :: vl_dim = "
    407                    + kpp_switches.get_vector_length() );
    408    mz_kpp.add_line("  INTEGER                     :: vl                              ");
     422   mz_kpp.add_line("  integer,parameter          :: VL_DIM = "
     423                 + kpp_switches.get_vector_length() );
     424   mz_kpp.add_line("  integer                     :: vl                              ");
    409425   mz_kpp.add_line("                                                                 ");
    410    mz_kpp.add_line("  INTEGER                     :: vl_glo                          ");
    411    mz_kpp.add_line("  INTEGER                     :: is,ie                           ");
     426   mz_kpp.add_line("  integer                     :: VL_glo                          ");
     427   mz_kpp.add_line("  integer                     :: is,ie                           ");
    412428   mz_kpp.add_line("                                                                 ");
    413    mz_kpp.add_line("  INTEGER,  DIMENSION(vl_dim)  :: kacc, krej                      ");
    414    mz_kpp.add_line("  INTEGER,  DIMENSION(vl_dim)  :: ierrv                           ");
    415    mz_kpp.add_line("  LOGICAL                     :: data_loaded = .false.             ");
    416    
     429   mz_kpp.add_line("                                                                 ");
     430   mz_kpp.add_line("  integer, dimension(VL_dim)   :: Kacc,Krej                       ");
     431   mz_kpp.add_line("  integer, dimension(VL_dim)   :: IERRV                           ");
     432   mz_kpp.add_line("  logical                     :: data_loaded = .false.             ");
     433
    417434   in.close();
    418 
    419 //    in_e5.open("module_header_e5");
    420 //    if( !in_e5 ) {
    421 //       cout << "cannot open " << endl; my_abort("module_header_e5");
    422 //    }
    423 
    424 //    while ( 1 ) {
    425 //      getline (in_e5, buf);
    426 //      if( in_e5.eof() ) break;
    427 //      if( in_e5.bad() ) my_abort("ERROR_READ_4");
    428 //      line.set_line(buf);
    429 //      e5_kpp.add_line(line);
    430 //    }
    431 //    in_e5.close();
    432435
    433436   return;
     
    448451   out.close();
    449452   
    450 //    out_file  = "kk_mecca_kpp_e5.f90";
    451 //    out_e5.open(out_file.c_str(), ios::out);
    452 //    if( !out_e5 ) {
    453 //       cout << "cannot open " << endl; my_abort(out_file);
    454 //    }
    455 
    456 //    e5_kpp.write_file (out_e5);
    457 
    458 //    out_e5.close();
    459453
    460454   return;
     
    468462   kppi.set_name("chem_gasphase_integrate");
    469463
    470    kppi.add_line("SUBROUTINE chem_gasphase_integrate (time_step_len, conc, tempk, photo, ierrf, xnacc, xnrej, istatus, l_debug, pe )  ");
     464   kppi.add_line("SUBROUTINE chem_gasphase_integrate (time_step_len, conc, tempi, qvapi, fakti, photo, ierrf, xnacc, xnrej, istatus, l_debug, pe, icntrl_i, rcntrl_i )  ");
    471465   kppi.add_line("                                                                    ");
    472466   kppi.add_line("  IMPLICIT NONE                                                     ");
    473467   kppi.add_line("                                                                    ");
    474468
    475    kppi.add_line("  REAL(dp),  INTENT(IN)                    :: time_step_len           ");
     469   kppi.add_line("  REAL(dp), INTENT(IN)                   :: time_step_len           ");
    476470   kppi.add_line("  REAL(dp),  DIMENSION(:,:),  INTENT(INOUT) :: conc                    ");
    477    kppi.add_line("  REAL(dp),  DIMENSION(:,:),  INTENT(INOUT) :: photo                   ");
    478    kppi.add_line("  REAL(dp),  DIMENSION(:),  INTENT(IN)      :: tempk                   ");
    479    kppi.add_line("  INTEGER,  INTENT(OUT),  OPTIONAL          :: ierrf(:)                ");
    480    kppi.add_line("  INTEGER,  INTENT(OUT),  OPTIONAL          :: xnacc(:)                ");
    481    kppi.add_line("  INTEGER,  INTENT(OUT),  OPTIONAL          :: xnrej(:)                ");
    482    kppi.add_line("  INTEGER,  INTENT(INOUT),  OPTIONAL        :: istatus(:)              ");
    483    kppi.add_line("  INTEGER,  INTENT(IN),  OPTIONAL           :: pe                      ");
    484    kppi.add_line("  LOGICAL,  INTENT(IN),  OPTIONAL           :: l_debug                 ");
     471   kppi.add_line("  REAL(dp),  DIMENSION(:,:),  INTENT(IN)    :: photo                   ");
     472   kppi.add_line("  REAL(dp),  DIMENSION(:),  INTENT(IN)      :: tempi                   ");
     473   kppi.add_line("  REAL(dp),  DIMENSION(:),  INTENT(IN)      :: qvapi                   ");
     474   kppi.add_line("  REAL(dp),  DIMENSION(:),  INTENT(IN)      :: fakti                   ");
     475   kppi.add_line("  INTEGER,  INTENT(OUT), OPTIONAL        :: ierrf(:)                ");
     476   kppi.add_line("  INTEGER,  INTENT(OUT), OPTIONAL        :: xNacc(:)                ");
     477   kppi.add_line("  INTEGER,  INTENT(OUT), OPTIONAL        :: xNrej(:)                ");
     478   kppi.add_line("  INTEGER,  INTENT(INOUT), OPTIONAL      :: istatus(:)              ");
     479   kppi.add_line("  INTEGER,  INTENT(IN), OPTIONAL         :: PE                      ");
     480   kppi.add_line("  LOGICAL,  INTENT(IN), OPTIONAL         :: l_debug                 ");
     481   kppi.add_line("  INTEGER,  DIMENSION(nkppctrl),INTENT(IN), OPTIONAL  :: icntrl_i         ");
     482   kppi.add_line("  REAL(dp), DIMENSION(nkppctrl),INTENT(IN), OPTIONAL  :: rcntrl_i         ");
    485483   kppi.add_line("                                                                    ");
    486484   kppi.add_line("  INTEGER                                 :: k   ! loop variable     ");
    487485   kppi.add_line("  REAL(dp)                                :: dt                      ");
    488    kppi.add_line("  INTEGER,  DIMENSION(20)                  :: istatus_u               ");
    489    kppi.add_line("  INTEGER                                 :: ierr_u                  ");
    490    kppi.add_line("                                                                    ");
    491    kppi.add_line("                                                                    ");
    492    kppi.add_line("  if (present (istatus) )  istatus = 0                              ");
    493    kppi.add_line("                                                                    ");
    494 // kppi.add_line("  vk_glo = size(tempk,1)                                            ");
    495 // kppi.add_line("                                                                    ");
    496 
    497    kppi.add_line("  DO k=1,vl_glo,vl_dim                                              ");
     486   kppi.add_line("  integer, dimension(20)                 :: istatus_u               ");
     487   kppi.add_line("  integer                                :: ierr_u                  ");
     488   kppi.add_line("  integer                                :: istatf                  ");
     489   kppi.add_line("  integer                                :: vl_dim_lo               ");
     490   kppi.add_line("                                                                    ");
     491   kppi.add_line("                                                                    ");
     492   kppi.add_line("  if (present (istatus) )   istatus = 0                             ");
     493   kppi.add_line("  if (present (icntrl_i) )  icntrl  = icntrl_i                      ");
     494   kppi.add_line("  if (present (rcntrl_i) )  rcntrl  = rcntrl_i                      ");
     495   kppi.add_line("                                                                    ");
     496   kppi.add_line("  vl_glo = size(tempi,1)                                            ");
     497   kppi.add_line("                                                                    ");
     498   kppi.add_line("  vl_dim_lo = VL_DIM                                                ");
     499   kppi.add_line("  DO k=1,VL_glo,vl_dim_lo                                           ");
    498500   kppi.add_line("    is = k                                                          ");
    499    kppi.add_line("    ie = min(k+vl_dim-1,vl_glo)                                     ");
     501   kppi.add_line("    ie = min(k+vl_dim_lo-1,VL_glo)                                  ");
    500502   kppi.add_line("    vl = ie-is+1                                                    ");
    501503
    502504   kppi.add_line("                                                                    ");
    503505   if(kpp_switches.is_vector()) {
    504      kppi.add_line("    c(1:vl,:) = conc(is:ie,:)                                     ");
    505    } else {
    506      kppi.add_line("    c(:) = conc(is,:)                                             ");
    507    }
    508    kppi.add_line("                                                                    ");
    509    if(kpp_switches.is_vector()) {
    510      kppi.add_line("    temp(1:vl) = tempk(is:ie)                                     ");
    511    } else {
    512      kppi.add_line("    temp = tempk(is)                                              ");
    513    }
     506     kppi.add_line("    C(1:vl,:) = Conc(is:ie,:)                                     ");
     507   } else {
     508     kppi.add_line("    C(:) = Conc(is,:)                                             ");
     509   }
     510
     511   kppi.add_line("                                                                    ");
     512   if(kpp_switches.is_vector()) {
     513     kppi.add_line("    temp(1:vl) = tempi(is:ie)                                     ");
     514   } else {
     515     kppi.add_line("    temp = tempi(is)                                              ");
     516   }
     517   kppi.add_line("                                                                    ");
     518   if(kpp_switches.is_vector()) {
     519     kppi.add_line("    qvap(1:vl) = qvapi(is:ie)                                     ");
     520   } else {
     521     kppi.add_line("    qvap = qvapi(is)                                              ");
     522   }
     523   kppi.add_line("                                                                    ");
     524   if(kpp_switches.is_vector()) {
     525     kppi.add_line("    fakt(1:vl) = fakti(is:ie)                                     ");
     526   } else {
     527     kppi.add_line("    fakt = fakti(is)                                              ");
     528   }
     529
     530   kppi.add_line("                                                                    ");
     531   kppi.add_line("    CALL initialize                                                 ");
     532
    514533   kppi.add_line("                                                                    ");
    515534   if(kpp_switches.is_vector()) {
     
    528547   kppi.add_line("                                                                    ");
    529548   if(kpp_switches.is_vector()) {
    530      kppi.add_line("    conc(is:ie,:) = c(1:VL,:)                                     ");
    531    } else {
    532      kppi.add_line("    IF (PRESENT(l_debug) .AND. PRESENT(pe)) THEN                       ");
    533      kppi.add_line("       IF (l_debug) CALL error_output(conc(is,:),ierr_u, pe)           ");
    534      kppi.add_line("    ENDIF                                                              ");
    535      kppi.add_line("    conc(is,:) = c(:)                                                  ");
     549     kppi.add_line("    Conc(is:ie,:) = C(1:VL,:)                                     ");
     550   } else {
     551     kppi.add_line("   IF (PRESENT(l_debug) .AND. PRESENT(PE)) THEN                       ");
     552     kppi.add_line("      IF (l_debug) CALL error_output(Conc(is,:),ierr_u, PE)           ");
     553     kppi.add_line("   ENDIF                                                              ");
     554     kppi.add_line("                                                                      ");
     555     kppi.add_line("    Conc(is,:) = C(:)                                                 ");
    536556   }
    537557
     
    540560   kppi.add_line("                                                                    ");
    541561   if(kpp_switches.is_vector()) {
    542      kppi.add_line("    if(PRESENT(ierrf))    ierrf(is:ie) = ierrv(1:vl)              ");
    543      kppi.add_line("    if(PRESENT(xnacc))    xnacc(is:ie) = kacc(1:vl)               ");
    544      kppi.add_line("    if(PRESENT(xnrej))    xnrej(is:ie) = krej(1:vl)               ");
    545    } else {
    546      kppi.add_line("    if(PRESENT(ierrf))    ierrf(is) = ierr_u                      ");
    547      kppi.add_line("    if(PRESENT(xnacc))    xnacc(is) = istatus_u(4)                ");
    548      kppi.add_line("    if(PRESENT(xnrej))    xnrej(is) = istatus_u(5)                ");
    549    }
    550    kppi.add_line("                                                                    ");
    551    kppi.add_line("    if (PRESENT (istatus) )  then                                   ");
    552    if(kpp_switches.is_vector()) {
    553      kppi.add_line("      istatus(4) =   istatus(4) + sum(kacc(1:vl))                  ");
    554      kppi.add_line("      istatus(5) =   istatus(5) + sum(krej(1:vl))                  ");
     562     kppi.add_line("    if(Present(ierrf))    ierrf(is:ie) = IERRV(1:VL)              ");
     563     kppi.add_line("    if(Present(xNacc))    xNacc(is:ie) = Kacc(1:VL)               ");
     564     kppi.add_line("    if(Present(xNrej))    xNrej(is:ie) = Krej(1:VL)               ");
     565   } else {
     566     kppi.add_line("    if(Present(ierrf))    ierrf(is) = IERR_U                      ");
     567     kppi.add_line("    if(Present(xNacc))    xNacc(is) = istatus_u(4)                ");
     568     kppi.add_line("    if(Present(xNrej))    xNrej(is) = istatus_u(5)                ");
     569   }
     570   kppi.add_line("                                                                    ");
     571   kppi.add_line("    if (present (istatus) )  then                                   ");
     572   if(kpp_switches.is_vector()) {
     573     kppi.add_line("      istatus(4) =   istatus(4) + sum(Kacc(1:VL))                  ");
     574     kppi.add_line("      istatus(5) =   istatus(5) + sum(Krej(1:VL))                  ");
    555575     kppi.add_line("      istatus(3) =   istatus(4) + istatus(5)                       ");
    556576     kppi.add_line("      istatus(6) =   istatus(6) + istatus_u(6)                     ");
     
    559579     kppi.add_line("      istatus(1:8) = istatus(1:8) + istatus_u(1:8)                 ");
    560580   }
    561    kppi.add_line("    ENDIF                                                          ");
     581   kppi.add_line("    end if                                                          ");
    562582   kppi.add_line("                                                                    ");
    563583   kppi.add_line("  END DO                                                            ");
     
    568588   kppi.add_line("                                                                    ");
    569589   for(iv=Vvar_list.begin();iv!=Vvar_list.end();iv++) {
    570      kppi.add_line("  if (ALLOCATED("+ iv->name +"))   DEALLOCATE("+ iv->name +" )    ");
     590//     kppi.add_line("  if (allocated("+ iv->name +"))   deallocate("+ iv->name +" )    ");
    571591   }
    572592
     
    574594   kppi.add_line("  data_loaded = .false.                                             ");
    575595   kppi.add_line("                                                                    ");
    576    kppi.add_line("  RETURN                                                            ");
     596   kppi.add_line("  return                                                            ");
    577597   kppi.add_line("END SUBROUTINE chem_gasphase_integrate                                        ");
    578598
     
    583603}
    584604
    585 void create_kpp_module::create_fill_routine(vector<fortran_file> &fi_list, Vvar & var) {
    586    fortran_file                         fi;
    587    vector<string>::iterator             is;
    588    string                               line;
    589 
    590    cout << "Generate fill subroutine for " << var.name << endl;
    591 
    592    fi.set_name(var.name);
    593    line = "  SUBROUTINE fill_" + var.name;
    594    fi.add_line(line + "(status, array) ");
    595      fi.add_line(" ");
    596      fi.add_line("    INTEGER,  INTENT(OUT)               :: status ");
    597    if(var.nr_dim() == 0) {
    598      fi.add_line("    REAL(dp),  INTENT(IN),  DIMENSION(:) :: array ");
    599      fi.add_line(" ");
    600      fi.add_line("    status = 0");
    601      fi.add_line("    IF (.not. ALLOCATED("+var.name+")) & ");
    602      fi.add_line("       ALLOCATE("+var.name+"(size(array))) ");
    603    } else if(var.nr_dim() == 1) {
    604      fi.add_line("    REAL (dp), INTENT(IN), DIMENSION(:,:) :: array ");
    605      fi.add_line(" ");
    606      fi.add_line("    status = 0 ");
    607      fi.add_line("    if (.not. ALLOCATED("+var.name+")) & ");
    608      fi.add_line("        ALLOCATE("+var.name+"(size(array,1),"+var.dim_var[0]+")) ");
    609    } else if(var.nr_dim() == 2) {
    610      fi.add_line(" ");
    611      fi.add_line("    REAL (dp), INTENT(IN), DIMENSION(:,:,:) :: array ");
    612      fi.add_line(" ");
    613      fi.add_line("    status = 0 ");
    614      fi.add_line("    if (.not. ALLOCATED("+var.name+")) & ");
    615      fi.add_line("        ALLOCATE("+var.name+"(size(array,1),"+var.dim_var[0]+var.dim_var[1]+")) ");
    616    } else {
    617      fi.add_line("    REAL (dp), INTENT(IN), DIMENSION(:,:,:,:) :: array ");
    618      fi.add_line(" ");
    619      fi.add_line("    status = 0 ");
    620      fi.add_line("    IF (.not. ALLOCATED("+var.name+")) & ");
    621      fi.add_line("        ALLOCATE("+var.name+"(size(array,1),"+var.dim_var[0]
    622                                +var.dim_var[1]+var.dim_var[3]+")) ");
    623    }
    624 
    625    fi.add_line(" ");
    626    fi.add_line("    IF (data_loaded .AND. (vl_glo /= size(array,1)) )  THEN ");
    627    fi.add_line("       status = 1 ");
    628    fi.add_line("       RETURN ");
    629    fi.add_line("    END IF ");
    630    fi.add_line(" ");
    631    fi.add_line("    vl_glo = size(array,1) ");
    632    fi.add_line("    "+var.name+ " = array ");
    633    fi.add_line("    data_loaded = .TRUE. ");
    634    fi.add_line(" ");
    635    fi.add_line("    RETURN");
    636    fi.add_line(" ");
    637    fi.add_line("  END " + line);
    638 
    639    fi_list.push_back(fi);
    640 
    641    return;
    642 }
  • palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/create_kpp_module.h

    r2696 r3298  
    11#ifndef mecca
    2 #define mecca 1
     2// ketelsen 18.09.2018: Removed create_fill_routine
    33
    4 // ############################################################################
    5 //
    6 //     create_mz_kpp_module
    7 //
    8 //     create scalar code from .f90 sources created by KPP to be used in MESSy
    9 //
    10 //     COPYRIGHT Klaus Ketelsen and MPI-CH   April 2007
    11 //
    12 // ############################################################################
     4#include <iostream>
     5#include <fstream>
     6
     7#include <string>
     8#include <list>
     9#include <vector>
     10
     11#include "fortran_file.h"
     12#include "expand_decomp.h"
     13
     14// Class to create module which contains code generated by kpp.
     15
     16/
     17/
     18// ketelsen 18.09.2018: Removed create_fill_routine
    1319
    1420#include <iostream>
     
    4854
    4955  void create_kpp_integrate();
    50   void create_fill_routine(vector<fortran_file> &e5_list, Vvar &var );
    51  public:
     56
     57public:
    5258
    5359  void do_work (string s) ;
  • palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/expand_decomp.C

    r2696 r3298  
    165165  vector<fortran_file>::iterator  it;
    166166  fortran_file                    de;
    167   int                             k,kk,j,jj,i,ii;
     167  int                             k,kk,j,jj,i;
    168168  string                          line;
    169169  char                            cline[80];
  • 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);
  • palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/fortran_file.h

    r2696 r3298  
    1212// ############################################################################
    1313//
    14 //  Modifications:
    15 //    RFo added global_subtolower
     14//Current revisions:
     15//------------------
     16/
     17/
     18//Former revisions:
     19//-----------------
     20// Nov 2016: Intial version of KP4 adapted to PALM (Klaus Ketelsen)
     21//  forkel Sept.2018:  added edit_Initialize
     22//  forkel          :  added global_subtolower
     23//
     24/ Intial version of KP4
     25
    1626
    1727#include <iostream>
     
    4252  void edit_KppSolve () ;
    4353  void edit_Fun () ;
     54  void edit_WAXPY () ;
     55  void edit_FunTemplate () ;
     56  void edit_JacTemplate () ;
    4457  void edit_FUNC () ;
    4558  void edit_Update_RCONST (vector <Vvar> &var_list) ;
     59  void edit_Initialize (vector <Vvar> &var_list) ;
    4660  void edit_inc (fortran_file & header_var) ;
    4761  void create_species_list(vector <string> &species_list);
  • palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/fortran_file_vec.C

    r2696 r3298  
    99//
    1010// ############################################################################
     11//Current revisions:
     12//------------------
     13/
     14/
     15//Former revisions:
     16//-----------------
     17//$Id: fortran_file.C 2470 2017-09-14 13:56:42Z forkel $
     18//  ketelsen 18.09.2018: Line 112: do k=is,ie bydo k=1,vl; line 156 ff: replaced index k by j
     19//
     20//  forkel Sept.2018:  added edit_Initialize
     21//                     changed loop direction for update_rconst in edit_Update_RCONST
     22/ 2017-09-14 13:56:42Z forkel $
     23//
     24//
     25// Nov 2016: Intial version of KP4 adapted to PALM (Klaus Ketelsen)
     26//
     27
    1128
    1229#include <fstream>
     
    7794    }
    7895  }
     96
     97  for (ip=pline.begin(); ip != pline.end(); ip++) {
     98      if(kpp_switches.is_vector() ) {
     99          ip->global_substitute ("phot (","phot(j,");
     100      }
     101  }
     102
    79103  ip = pline.begin()+1 ;
    80104  lo_line = ip->get_line() ;
    81105  lo_line.erase();
    82   lo_line = " INTEGER         :: j,k";
     106  if(kpp_switches.is_vector() ) {
     107    lo_line = " INTEGER         :: j,k";
     108  } else {
     109    lo_line = " INTEGER         :: k";
     110  }
    83111  ip->set_line(lo_line);
    84112 
     
    87115    lo_line = ip->get_line() ;
    88116    lo_line.erase();
    89     lo_line = " do k=is,ie";
     117    lo_line = " do k=1,vl";
    90118    ip->set_line(lo_line);
    91119
     
    93121    lo_line = ip->get_line() ;
    94122    lo_line.erase();
    95     lo_line = "  j = k-is+1";
     123    lo_line = "  j = k";
    96124    ip->set_line(lo_line);
    97125
     
    103131  } else {
    104132    ip = pline.begin()+3 ;
     133    lo_line = ip->get_line() ;
     134    lo_line.erase();
     135    lo_line = "  k = is";
     136    ip->set_line(lo_line);
     137  }
     138
     139  return;
     140}
     141
     142void fortran_file::edit_Initialize (vector <Vvar> &var_list) {
     143  vector<program_line>::iterator     ip;
     144  vector<Vvar>::iterator             iv;
     145  string                             lo_line;
     146
     147  for (ip=pline.begin(); ip != pline.end(); ip++) {
     148    ip->global_substitute ("*"," *");
     149    ip->global_substitute ("* *","**");
     150    ip->global_substitute (","," , ");
     151    ip->global_substitute ("/"," / ");
     152    ip->global_substitute ("1:VL","j");
     153  }
     154  for (ip=pline.begin(); ip != pline.end(); ip++) {
     155    for (iv=var_list.begin(); iv != var_list.end(); iv++) {
     156      ip->change_variable_to_vector_g (*iv);
     157    }
     158  }
     159
     160  for (ip=pline.begin(); ip != pline.end(); ip++) {
     161    if(kpp_switches.is_vector() ) {
     162          ip->global_substitute ("qvap","qvap(j)");
     163    }
     164  }
     165  for (ip=pline.begin(); ip != pline.end(); ip++) {
     166    if(kpp_switches.is_vector() ) {
     167          ip->global_substitute ("fakt","fakt(j)");
     168    }
     169  }
     170
     171  ip = pline.begin()+3 ;
     172  lo_line = ip->get_line() ;
     173  lo_line.erase();
     174  lo_line = "  INTEGER         :: j,k";
     175  ip->set_line(lo_line);
     176
     177  if(kpp_switches.is_vector() ) {
     178    ip = pline.begin()+9 ;
     179    lo_line = ip->get_line() ;
     180    lo_line.erase();
     181    lo_line = " do k = is,ie";
     182    ip->set_line(lo_line);
     183
     184    ip = pline.begin()+10 ;
     185    lo_line = ip->get_line() ;
     186    lo_line.erase();
     187    lo_line = "  j = k - is +1";
     188    ip->set_line(lo_line);
     189
     190    ip = pline.end()-2 ;
     191    lo_line = ip->get_line() ;
     192//  lo_line.erase();
     193    lo_line = " end do";
     194    ip->set_line(lo_line);
     195  } else {
     196    ip = pline.begin()+7 ;
    105197    lo_line = ip->get_line() ;
    106198    lo_line.erase();
     
    236328}
    237329
     330void fortran_file::edit_WAXPY () {
     331
     332  vector<program_line>::iterator     ip;
     333
     334  cout << "Handling subroutine: WAXPY" <<endl;
     335
     336  for (ip=pline.begin(); ip != pline.end(); ip++) {
     337
     338    if(ip->get_token(0) == "REAL") {
     339       ip->substitute("N",":,:");
     340       ip->substitute("N",":,:");
     341       ip->substitute("Alpha","Alpha(:)");
     342    } else {
     343        ip->change_variable_to_vector ("Y");
     344        ip->change_variable_to_vector ("X");
     345        if(ip->get_token(0) != "SUBROUTINE") {
     346                if(ip->get_token(0) == "IF")  {
     347                        ip->substitute("Alpha","SUM(alpha(1:VL))");
     348                } else {
     349                        ip->substitute("Alpha","alpha(1:VL)");
     350                }
     351        }
     352    }
     353
     354
     355  }
     356
     357  return;
     358}
     359
     360void fortran_file::edit_FunTemplate () {
     361
     362  vector<program_line>::iterator     ip;
     363
     364  cout << "Handling subroutine: FunTemplate" <<endl;
     365
     366  for (ip=pline.begin(); ip != pline.end(); ip++) {
     367
     368    if(ip->get_token(0) == "REAL") {
     369       ip->substitute("NVAR",":,:");
     370       ip->substitute("T,","T(:),");
     371       ip->substitute("Told","Told(size(T)),Time(size(T))");
     372    }
     373
     374
     375  }
     376
     377  return;
     378}
     379
     380void fortran_file::edit_JacTemplate () {
     381
     382  vector<program_line>::iterator     ip;
     383
     384  cout << "Handling subroutine: JacTemplate" <<endl;
     385
     386  for (ip=pline.begin(); ip != pline.end(); ip++) {
     387
     388    if(ip->get_token(0) == "REAL") {
     389        ip->substitute("NVAR",":,:");
     390        ip->substitute("T,","T(:),");
     391        ip->substitute("Told","Told(size(T)),Time(size(T))");
     392        ip->substitute("LU_NONZERO",":,:");
     393    }
     394
     395
     396  }
     397
     398  return;
     399}
     400
  • palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/program_line.C

    r2696 r3298  
    134134  return;
    135135}
     136void   program_line::global_subtolower(string &line) {
    136137
     138   int start = line.size()-1;
     139   char c;
     140
     141    int i = 0;
     142    while (line[i])
     143    {
     144      c = line[i];
     145      line[i] = tolower(c);
     146      i++;
     147    }
     148   return;
     149}
     150
  • palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/program_line.h

    r2696 r3298  
    1111//
    1212// ############################################################################
     13//
     14// forkel June 2018: added    void   global_subtolower(string &line);
    1315
    1416#include <iostream>
     
    4244   void   change_variable_to_vector    (string var);
    4345   void   change_variable_to_vector_g  (Vvar  &var);
     46   void   global_subtolower(string &line);
    4447};
    4548
Note: See TracChangeset for help on using the changeset viewer.