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

Location:
palm/trunk/UTIL/chemistry/gasphase_preproc
Files:
2 deleted
21 edited
8 copied

Legend:

Unmodified
Added
Removed

  • palm/trunk/UTIL/chemistry/gasphase_preproc/kpp/src/lex.yy.c

    r2696 r3298  
    1010#define YY_FLEX_MAJOR_VERSION 2
    1111#define YY_FLEX_MINOR_VERSION 5
    12 #define YY_FLEX_SUBMINOR_VERSION 37
     12#define YY_FLEX_SUBMINOR_VERSION 35
    1313#if YY_FLEX_SUBMINOR_VERSION > 0
    1414#define FLEX_BETA
    … …  
    143143/* Size of default input buffer. */
    144144#ifndef YY_BUF_SIZE
     145#ifdef __ia64__
     146/* On IA-64, the buffer size is 16k, not 8k.
     147 * Moreover, YY_BUF_SIZE is 2*YY_READ_BUF_SIZE in the general case.
     148 * Ditto for the __ia64__ case accordingly.
     149 */
     150#define YY_BUF_SIZE 32768
     151#else
    145152#define YY_BUF_SIZE 16384
     153#endif /* __ia64__ */
    146154#endif
    147155
    … …  
    155163#endif
    156164
    157 #ifndef YY_TYPEDEF_YY_SIZE_T
    158 #define YY_TYPEDEF_YY_SIZE_T
    159 typedef size_t yy_size_t;
    160 #endif
    161 
    162 extern yy_size_t yyleng;
     165extern int yyleng;
    163166
    164167extern FILE *yyin, *yyout;
    … …  
    186189#define unput(c) yyunput( c, (yytext_ptr)  )
    187190
     191#ifndef YY_TYPEDEF_YY_SIZE_T
     192#define YY_TYPEDEF_YY_SIZE_T
     193typedef size_t yy_size_t;
     194#endif
     195
    188196#ifndef YY_STRUCT_YY_BUFFER_STATE
    189197#define YY_STRUCT_YY_BUFFER_STATE
    … …  
    203211         * characters.
    204212         */
    205         yy_size_t yy_n_chars;
     213        int yy_n_chars;
    206214
    207215        /* Whether we "own" the buffer - i.e., we know we created it,
    … …  
    273281/* yy_hold_char holds the character lost when yytext is formed. */
    274282static char yy_hold_char;
    275 static yy_size_t yy_n_chars;            /* number of characters read into yy_ch_buf */
    276 yy_size_t yyleng;
     283static int yy_n_chars;          /* number of characters read into yy_ch_buf */
     284int yyleng;
    277285
    278286/* Points to current character in buffer. */
    … …  
    302310YY_BUFFER_STATE yy_scan_buffer (char *base,yy_size_t size  );
    303311YY_BUFFER_STATE yy_scan_string (yyconst char *yy_str  );
    304 YY_BUFFER_STATE yy_scan_bytes (yyconst char *bytes,yy_size_t len  );
     312YY_BUFFER_STATE yy_scan_bytes (yyconst char *bytes,int len  );
    305313
    306314void *yyalloc (yy_size_t  );
    … …  
    801809          return (x); \
    802810        }
    803 #line 804 "lex.yy.c"
     811#line 812 "lex.yy.c"
    804812
    805813#define INITIAL 0
    … …  
    864872void yyset_out  (FILE * out_str  );
    865873
    866 yy_size_t yyget_leng (void );
     874int yyget_leng (void );
    867875
    868876char *yyget_text (void );
    … …  
    906914/* Amount of stuff to slurp up with each read. */
    907915#ifndef YY_READ_BUF_SIZE
     916#ifdef __ia64__
     917/* On IA-64, the buffer size is 16k, not 8k */
     918#define YY_READ_BUF_SIZE 16384
     919#else
    908920#define YY_READ_BUF_SIZE 8192
     921#endif /* __ia64__ */
    909922#endif
    910923
    … …  
    10091022#line 120 "scan.l"
    10101023
    1011 #line 1012 "lex.yy.c"
     1024#line 1025 "lex.yy.c"
    10121025
    10131026        if ( !(yy_init) )
    … …  
    15261539ECHO;
    15271540        YY_BREAK
    1528 #line 1529 "lex.yy.c"
     1541#line 1542 "lex.yy.c"
    15291542
    15301543        case YY_END_OF_BUFFER:
    … …  
    17101723        else
    17111724                {
    1712                         yy_size_t num_to_read =
     1725                        int num_to_read =
    17131726                        YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1;
    17141727
    … …  
    17171730
    17181731                        /* just a shorter name for the current buffer */
    1719                         YY_BUFFER_STATE b = YY_CURRENT_BUFFER_LVALUE;
     1732                        YY_BUFFER_STATE b = YY_CURRENT_BUFFER;
    17201733
    17211734                        int yy_c_buf_p_offset =
    … …  
    17241737                        if ( b->yy_is_our_buffer )
    17251738                                {
    1726                                 yy_size_t new_size = b->yy_buf_size * 2;
     1739                                int new_size = b->yy_buf_size * 2;
    17271740
    17281741                                if ( new_size <= 0 )
    … …  
    17551768                /* Read in more data. */
    17561769                YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]),
    1757                         (yy_n_chars), num_to_read );
     1770                        (yy_n_chars), (size_t) num_to_read );
    17581771
    17591772                YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
    … …  
    18501863        yy_is_jam = (yy_current_state == 198);
    18511864
    1852                 return yy_is_jam ? 0 : yy_current_state;
     1865        return yy_is_jam ? 0 : yy_current_state;
    18531866}
    18541867
    … …  
    18651878                { /* need to shift things up to make room */
    18661879                /* +2 for EOB chars. */
    1867                 register yy_size_t number_to_move = (yy_n_chars) + 2;
     1880                register int number_to_move = (yy_n_chars) + 2;
    18681881                register char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[
    18691882                                        YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2];
    … …  
    19141927                else
    19151928                        { /* need more input */
    1916                         yy_size_t offset = (yy_c_buf_p) - (yytext_ptr);
     1929                        int offset = (yy_c_buf_p) - (yytext_ptr);
    19171930                        ++(yy_c_buf_p);
    19181931
    … …  
    20742087}
    20752088
     2089#ifndef __cplusplus
     2090extern int isatty (int );
     2091#endif /* __cplusplus */
     2092   
    20762093/* Initializes or reinitializes a buffer.
    20772094 * This function is sometimes called more than once on the same buffer,
    … …  
    21862203static void yyensure_buffer_stack (void)
    21872204{
    2188         yy_size_t num_to_alloc;
     2205        int num_to_alloc;
    21892206   
    21902207        if (!(yy_buffer_stack)) {
    … …  
    22832300 * @return the newly allocated buffer state object.
    22842301 */
    2285 YY_BUFFER_STATE yy_scan_bytes  (yyconst char * yybytes, yy_size_t  _yybytes_len )
     2302YY_BUFFER_STATE yy_scan_bytes  (yyconst char * yybytes, int  _yybytes_len )
    22862303{
    22872304        YY_BUFFER_STATE b;
    … …  
    23702387 *
    23712388 */
    2372 yy_size_t yyget_leng  (void)
     2389int yyget_leng  (void)
    23732390{
    23742391        return yyleng;

  • palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/bin/kpp4palm.ksh

    r2718 r3298  
    2121# Copyright 2017-2018  Leibniz Universitaet Hannover
    2222#------------------------------------------------------------------------------#
     23# Nov. 2016: Initial Version of KPP chemistry convertor adapted for PALM
     24# by Klaus Ketelsen
     25#
     26# This code is a modified version of KP4 (Jöckel, P., Kerkweg, A., Pozzer, A.,
     27# Sander, R., Tost, H., Riede, H., Baumgaertner, A., Gromov, S., and Kern, B.,
     28# 2010: Development cycle 2 of the Modular Earth Submodel System (MESSy2),
     29# Geosci. Model Dev., 3, 717-752, https://doi.org/10.5194/gmd-3-717-2010).
     30# KP4 is part of the Modular Earth Submodel System (MESSy), which is is
     31# available under the  GNU General Public License (GPL).
     32#
     33#------------------------------------------------------------------------------#
    2334#
    2435# Current revisions:
    … …  
    2940# -----------------
    3041# $Id$
     42# forkel   25. September 2018: Added cat for $MECH to pass mechanism name to kpp4palm
     43# ketelsen 18. September 2018: Added cat for '#INLINE F90_GLOBAL'
     44# (moved here from mechanisms/def_MECH/chem_gasphase.kpp
     45#
     46# forkel: 14. September  2018: WCOPY removed
     47# ketelsen: July 2018: Adaptations for vektor mode
     48# forkel June 2018: re-established original case of subroutine names
     49# forkel May 2018: additional copying of chem_gasphase_mod.f90 into $DEFDIR
     50# forkel 20.04.2018: removed  wlamch and wlamch_add from $KPP_SUBROUTINE_LIST
     51#                    (epsilon(one) is used now)
     52# forkel March 2017
     53# Re-introduced relative path for KPP_HOME
     54# Subroutine list adapted to lowercase subroutine names
     55# Added arr2, removed update_sun and k_3rd from subroutine list
     56# Renamed output file to chem_gasphase_mod
     57# Renamed this file from kp4/ksh to kpp4kpp.ksh
     58# changed location of def_mechanism directories to gasphase_preproc/mechanisms
     59#
     60#
     61# 2718 2018-01-02 08:49:38Z maronga
    3162# Initial revision
    3263#
    3364#
     65##########################################################################
    3466#
    3567#
    … …  
    6395# Default
    6496
     97MECH=smog
    6598OUTDIR=`pwd`/../../../SOURCE
    6699OUTFILE=chem_gasphase_mod
    … …  
    70103VLEN=1
    71104KEEP="NO"
    72 DE_INDEX="NO"
    73 DE_INDEX_FAST="NO"
     105UPDT="NO"
     106DE_INDEX=0
     107DE_INDEX_FAST="YES"
    74108
    75109export KPP_SOLVER=Rosenbrock
    … …  
    77111# get Command line option
    78112
    79 echo xxxxxxxxxx
    80 while  getopts :d:ifkp:o:s:v:w:  c     # get options
     113while  getopts :m:i:fkup:o:s:vl:w:  c     # get options
    81114do case $c in
    82       d)   DEFDIR=$OPTARG;;          # directory of definition files
    83 
    84       i)   DE_INDEX="YES";;          # if set, deindexing
     115      m)   MECH=$OPTARG;;            # mechanism
     116
     117      i)   DE_INDEX=$OPTARG;;        # if set, deindexing
    85118
    86119      f)   DE_INDEX_FAST="YES";;     # if set, fast deindexing
    … …  
    92125      p)   PREFIX=$OPTARG;;          # Name Prefix
    93126
    94       s)   KPP_SOLVER=$OPTARG;;      # Name Prefix
    95 
    96       v)   MODE="vector"
    97            VLEN=$OPTARG;;            # Set to vector Mode
     127      s)   KPP_SOLVER=$OPTARG;;      # Update sample f90 code in the def_MECH directory
     128
     129      u)   UPDT="YES";;              # keep Working directory
     130
     131      v)   MODE="vector";;           # Set to vector Mode
     132
     133      l)   VLEN=$OPTARG;;            # Set vector length
    98134
    99135      w)   WORK=$OPTARG;;            # Working directory
    100136
    101137      \?)  print ${0##*/} "unknown option:" $OPTARG
    102            print "USAGE: ${0##*/} [ -d dir -e -k -o dir -p name -s solver -v length -w dir ] "
     138           print "USAGE: ${0##*/} [ -m dir -e -k -u -o dir -p name -s solver -v -l length -w dir ] "
    103139           exit 1;;
    104140   esac
    … …  
    106142shift OPTIND-1
    107143
    108 echo $DEFDIR
     144echo MECHANISM = $MECH
     145echo DE_INDEX = $DE_INDEX
     146echo KEEP = $KEEP
     147echo UPDT = $UPDT
     148echo MODE = $MODE
     149echo VLEN = $VLEN
    109150
    110151DEF_PREFIX=${PREFIX}.kpp
     152DEFDIR=`pwd`/mechanisms/def_$MECH
     153echo DEFDIR = $DEFDIR
    111154
    112155# Create or clean working directory
    … …  
    122165
    123166
    124 KPP_SUBROUTINE_LIST="initialize"
    125 KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST integrate fun"
    126 KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST kppsolve kppdecomp wlamch wlamch_add"
    127 KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST jac_sp k_arr "
    128 KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST update_rconst arr2"
     167KPP_SUBROUTINE_LIST="Initialize"
     168KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST INTEGRATE Fun"
     169KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST KppSolve KppDecomp"
     170KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST Jac_SP k_arr "
     171KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST Update_RCONST ARR2"
    129172KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST initialize_kpp_ctrl error_output"
    130173
    … …  
    149192
    150193# Interface ignore list
    151 KPP_INTERFACE_IGNORE="waxpy wcopy"
     194KPP_INTERFACE_IGNORE=" "
     195
     196echo " "
     197echo KPP_SOLVER $KPP_SOLVER
     198echo " "
    152199
    153200case $KPP_SOLVER in
    … …  
    155202
    156203    Rosenbrock)   
    157       KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST wcopy wscal waxpy"
    158     if [[ $MODE != "vector" ]]
    159     then
    160       KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST rosenbrock  funtemplate jactemplate"
    161     fi;;
     204      KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST WSCAL WAXPY"
     205      if [[ $MODE != "vector" ]]
     206      then
     207         KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST Rosenbrock  FunTemplate JacTemplate"
     208        KPP_INTERFACE_IGNORE="WAXPY"
     209      else
     210        KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST FunTemplate JacTemplate"
     211      fi;;
    162212
    163213    rosenbrock_mz)
    … …  
    167217    rosenbrock)
    168218      KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST WCOPY WSCAL WAXPY"
    169       KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST rosenbrock  funtemplate jactemplate";;
     219      KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST Rosenbrock  FunTemplate JacTemplate";;
    170220
    171221    kpp_lsode)
    … …  
    203253cp $DEFDIR/${PREFIX}.kpp     .
    204254
     255# Global variable are defined here
     256# This has the advantage that it is not necessary to include these variables in all .kpp definition files
     257
     258cat  >> ${PREFIX}.kpp  <<  EOF
     259#INLINE F90_GLOBAL
     260! QVAP - Water vapor
     261  REAL(kind=dp) :: QVAP
     262! FAKT - Conversion factor
     263  REAL(kind=dp) :: FAKT
     264
     265#ENDINLINE
     266EOF
     267
     268# Store mechanism name in file mech_list
     269cat  >> mech_list  <<  EOF
     270!   Mechanism: $MECH
     271!
     272EOF
     273
    205274# Run kpp
    206275
    … …  
    240309done
    241310
     311echo start kp4.exe with arguments
     312echo $PREFIX $MODE $VLEN $DE_INDEX $DE_INDEX_FAST
     313
    242314$BASE/bin/kpp4palm.exe $PREFIX $MODE $VLEN $DE_INDEX $DE_INDEX_FAST
    243315
     316#Prelimanary, substitution has to be moved into kpp4palm.exe
     317if [[ $MODE = "vector" ]]
     318then
     319  sed -i -e 's/phot(nphot/phot(vl_dim,nphot/g' kk_kpp.f90
     320fi
    244321
    245322if [[ -e $OUTDIR/${OUTFILE}.f90 ]]
    … …  
    248325fi
    249326cp -p kk_kpp.f90    $OUTDIR/${OUTFILE}.f90
    250 #cp -p kk_kpp.f90    $MY_PWD/../SOURCE/${OUTFILE}.f90
    251 
    252327echo " "
    253328echo "Write kpp module -- > " $OUTDIR/${OUTFILE}.f90
     329
     330if [[ $UPDT = "YES" ]]
     331then
     332cp -p kk_kpp.f90    $DEFDIR/${OUTFILE}.f90
     333echo " "
     334echo "Write kpp module -- > " $DEFDIR/${OUTFILE}.f90
     335fi
    254336
    255337if [[ $KEEP = "NO" ]]

  • 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

  • palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/templates/initialize_kpp_ctrl_template.f90

    r2696 r3298  
    3232CONTAINS
    3333
    34 SUBROUTINE initialize_kpp_ctrl(status, iou, modstr)
     34SUBROUTINE initialize_kpp_ctrl(status)
    3535
    3636  IMPLICIT NONE
    … …  
    3838  ! I/O
    3939  INTEGER,          INTENT(OUT) :: status
    40   INTEGER,          INTENT(IN)  :: iou     ! logical I/O unit
    41   CHARACTER(LEN=*), INTENT(IN)  :: modstr  ! read <modstr>.nml
    4240
    4341  ! LOCAL

  • palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/templates/module_header

    r2718 r3298  
    33! ****** Module chem_gasphase_mod is automatically generated by kpp4palm ******
    44!
    5 !           ********* Please do NOT change this Code *********
     5!   ********* Please do NOT change this Code, it will be ovewritten *********
     6!
     7!------------------------------------------------------------------------------!
     8! This file was created by KPP (http://people.cs.vt.edu/asandu/Software/Kpp/)
     9! and kpp4palm (created by Klaus Ketelsen). kpp4palm is an adapted version
     10! of KP4 (Jöckel, P., Kerkweg, A., Pozzer, A., Sander, R., Tost, H., Riede,
     11! H., Baumgaertner, A., Gromov, S., and Kern, B., 2010: Development cycle 2 of
     12! the Modular Earth Submodel System (MESSy2), Geosci. Model Dev., 3, 717-752,
     13! https://doi.org/10.5194/gmd-3-717-2010). KP4 is part of the Modular Earth
     14! Submodel System (MESSy), which is is available under the  GNU General Public
     15! License (GPL).
     16!
     17! KPP is free software; you can redistribute it and/or modify it under the terms
     18! of the General Public Licence as published by the Free Software Foundation;
     19! either version 2 of the License, or (at your option) any later version.
     20! KPP is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
     21! without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
     22! PURPOSE. See the GNU General Public Licence for more details.
    623!
    724!------------------------------------------------------------------------------!
    … …  
    3047! -----------------
    3148! $Id: module_header 2460 2017-09-13 14:47:48Z forkel $
     49! forkel June 2018: qvap, fakt added
     50! forkel June 2018: reset case in  Initialize, Integrate, Update_rconst
     51!
     52!
     53! 2460 2017-09-13 14:47:48Z forkel
    3254!
    33 !
    34 ! Variables for photolyis added
    35 !
    36 !
    37 !
     55! forkel Sept. 2017: Variables for photolyis added
    3856!
    3957!
    … …  
    6482  PUBLIC :: nspec, nreact
    6583  PUBLIC :: temp
     84  PUBLIC :: qvap
     85  PUBLIC :: fakt
    6686  PUBLIC :: phot
    6787  PUBLIC :: rconst
    6888  PUBLIC :: nvar
    6989  PUBLIC :: nphot
     90  PUBLIC :: vl_dim                     ! Public to ebable other modules to distiguish between scalar and vec
    7091 
    71   PUBLIC :: initialize, integrate, update_rconst
     92  PUBLIC :: Initialize, Integrate, Update_rconst
    7293  PUBLIC :: chem_gasphase_integrate
    7394  PUBLIC :: initialize_kpp_ctrl

  • palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_passive/chem_gasphase_mod.kpp

    r2696 r3298  
    1111#HESSIAN    on
    1212#STOICMAT   on
    13 #INLINE F90_GLOBAL
    14   !   Declaration of global variable declarations for photolysis will come from INLINE F90_DATA
    15 #ENDINLINE
    1613//
    1714// *******************************************************************************************

  • palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_simple/chem_gasphase_mod.kpp

    r2696 r3298  
    11//chem_gasphase_mod.kpp
     2//
     3// Current revision
     4// forkel 20.04.2018: added F90_INIT for initialization of fix compounds
     5//
    26//
    37//Former revisions
    … …  
    1115#HESSIAN    on
    1216#STOICMAT   on
    13 #INLINE F90_GLOBAL
    14   !   Declaration of global variable declarations for photolysis will come from INLINE F90_DATA
    15 #ENDINLINE
    1617//
    1718// *******************************************************************************************

  • palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_simple/simple.eqn

    r2696 r3298  
    11{simple.eqn
    2 Former revisions
     2Current revision
    33----------------
    4  $Id: smog.eqn 2459 2017-09-13 14:10:33Z forkel $
     4 201711   Created simple.eqn with 6 equations forkel
     5 20180316 Added equation no. 7                forkel
    56}
    67#EQUATIONS
    78
    8 { very simple mechanism - do NOT show to a chemist! }
     9{ home made very simple mechanism - please do not show to a chemist! }
    910
    1011  { 1.}  NO2 + hv = NO + O3 :                   phot(j_no2)  ;
    … …  
    1415  { 5.}  RO2 + NO = NO2 + RCHO + HO2 :       arr2(4.2E-12_dp, -180.0_dp, temp);
    1516  { 6.}  HO2 + NO = NO2 + OH :               arr2(3.7E-12_dp, -240.0_dp, temp) ;
     17  { 7.}  NO2 + OH = HNO3     :               arr2(1.15E-11_dp, 0.0_dp, temp) ;

  • palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_smog/chem_gasphase_mod.kpp

    r2696 r3298  
    11//chem_gasphase_mod.kpp
     2//
     3// Current revision
     4// forkel 20.04.2018: added F90_INIT for initialization of fix compounds
     5//
    26//
    37//Former revisions
    … …  
    1115#HESSIAN    on
    1216#STOICMAT   on
    13 #INLINE F90_GLOBAL
    14   !   Declaration of global variable declarations for photolysis will come from INLINE F90_DATA
    15 #ENDINLINE
    1617//
    1718// *******************************************************************************************
    … …  
    3637#ENDINLINE
    3738
     39#INLINE F90_INIT
     40  fix(indf_h2o) = qvap
     41  fix(indf_o2)  = 0.2e+6_dp *  fakt
     42  fix(indf_co2) = 400.0_dp *  fakt
     43#ENDINLINE

  • palm/trunk/UTIL/chemistry/gasphase_preproc/run_kpp4palm.ksh

    r2718 r3298  
    2929# -----------------
    3030# $Id$
     31#  passed $MECH insted of $DEFDIR to kpp4palm.ksh                   forkel  25. Sept. 2018
     32#  re-activaded  choice of deindexing method and vector mode        forkel  June 2018
     33#
     34# 2718 2018-01-02 08:49:38Z maronga
    3135# Initial revision
    3236#
    … …  
    7276cd ..
    7377
    74 # run kpp4palm with default Setup
    75 #    -d   DEFDIR=$OPTARG;;          # directory of definition files
    76 #    -i   DE_INDEX="YES";;          # if set, deindexing
    77 #    -f   DE_INDEX_FAST="YES";;     # if set, fast deindexing
    78 #    -k   KEEP="NO";;               # keep Working directory
    79 #    -o   OUTDIR=$OPTARG;;          # Output directory of Geneated Code
    80 #    -p   PREFIX=$OPTARG;;          # Name Prefix
    81 #    -s   KPP_SOLVER=$OPTARG;;      # Name Prefix
     78# run kpp4palm/bin/kpp4palm.ksh with the following Setup
     79#    -d   DEFDIR=$OPTARG;;          # directory of definition files
     80#                                     (passed as `pwd`/mechanisms/def_$MECH)
     81#    -m   MECH="smog";;             # chemical mechanism
     82#                                     (smog, simple, simplep, cbm4, phstat, passive, passive1)
     83#    -i   DE_INDEX=2;;              # deindexing method (0,1,2,3; 0=no deindexing)
     84#    -v   MODE="-v";;               # vector mode on (not working completely yet)
     85#    -l   VLEN=$OPTARG;;            # Set vector length (not working completely yet)
     86#    -k   KEEP="NO";;               # if "yes" keep Working directory
     87#    -u   UPDT="NO";;               # if "yes" update the existing f90 code in the def_MECH directory
     88#                                   # Use "YES" with care as the existing sample file is overwritten
     89#
     90##   Further options (not passed as changing does not make sense to change these)
     91##    -f   DE_INDEX_FAST="YES";;     # if set, fast deindexing
     92##    -o   OUTDIR=$OPTARG;;          # Output directory of Generated Code
     93##                                     (`pwd`/../../../SOURCE)
     94##    -p   PREFIX=$OPTARG;;          # Name Prefix (chem_gasphase_mod)
     95##    -s   KPP_SOLVER=$OPTARG;;      # Name Prefix (rosenbrock)
    8296
    8397 
    … …  
    8599# use smog mechnism as default
    86100MECH=smog
     101DEIN=2
    87102
    88 while  getopts m:k  opt   # get options
     103while  getopts m:i:kuvl:  opt   # get options
    89104do case $opt in
    90105      m)   MECH=$OPTARG;;          # mechanism name as part of mechanisms/def_[mechanism_name]
    91106
     107      i)   DEIN=$OPTARG;;          # deindexing method (0,1,2,3; 0=no deindexing)
     108
    92109      k)   KEEP="-k";;             # keep Working directory
    93110
     111      u)   UPDT="-u";;             # update sample output file
     112
     113      v)   MODE="-v";;             # vector mode on
     114
     115      c)   COPY="-c";;             # copy output to def_MECH
     116
     117      l)   VLEN=$OPTARG;;          # Set vector length
     118
    94119      \?)  print ${0##*/} "unknown option:" $OPTARG
    95            print "USAGE: ${0##*/} [ -m mechanism_name] [ -k] "
     120           print "USAGE: ${0##*/} [ -m mechanism_name] [ -i n (n=0,1,2,3)] [ -k] [ -u] [ -v] [ -l N (N=vector length)]"
    96121           exit 1;;
    97122   esac
    98123done
    99 echo $MECH
     124echo Now do kpp4palm for $MECH
    100125
    101 kpp4palm.ksh -d `pwd`/mechanisms/def_$MECH $KEEP
     126# kpp4palm.ksh -d `pwd`/mechanisms/def_$MECH -i $DEIN $KEEP $UPDT $MODE -l $VLEN
     127kpp4palm.ksh -m $MECH -i $DEIN $KEEP $UPDT $MODE -l $VLEN
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |