Changeset 3298 for palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm
- Timestamp:
- Oct 2, 2018 12:21:11 PM (6 years ago)
- Location:
- palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm
- Files:
-
- 2 deleted
- 13 edited
- 1 copied
-
bin/kpp4palm.exe (modified) (previous)
-
bin/kpp4palm.ksh (modified) (14 diffs)
-
src/create_kpp_module.C (modified) (19 diffs)
-
src/create_kpp_module.h (modified) (2 diffs)
-
src/expand_decomp.C (modified) (1 diff)
-
src/fortran_file.C (modified) (12 diffs)
-
src/fortran_file.h (modified) (2 diffs)
-
src/fortran_file_vec.C (modified) (6 diffs)
-
src/kpp4palm.exe (modified) (previous)
-
src/program_line.C (modified) (1 diff)
-
src/program_line.h (modified) (2 diffs)
-
templates/Rosenbrock_vec.f90 (copied) (copied from palm/branches/chemistry/UTIL/chemistry/gasphase_preproc/kpp4palm/templates/Rosenbrock_vec.f90)
-
templates/initialize_kpp_ctrl_template.f90 (modified) (2 diffs)
-
templates/module_header (modified) (3 diffs)
-
templates/rosenbrock_vec.f90 (deleted)
-
templates/rosenbrock_vec.f90.save (deleted)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/bin/kpp4palm.ksh
r2718 r3298 21 21 # Copyright 2017-2018 Leibniz Universitaet Hannover 22 22 #------------------------------------------------------------------------------# 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 #------------------------------------------------------------------------------# 23 34 # 24 35 # Current revisions: … … 29 40 # ----------------- 30 41 # $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 31 62 # Initial revision 32 63 # 33 64 # 65 ########################################################################## 34 66 # 35 67 # … … 63 95 # Default 64 96 97 MECH=smog 65 98 OUTDIR=`pwd`/../../../SOURCE 66 99 OUTFILE=chem_gasphase_mod … … 70 103 VLEN=1 71 104 KEEP="NO" 72 DE_INDEX="NO" 73 DE_INDEX_FAST="NO" 105 UPDT="NO" 106 DE_INDEX=0 107 DE_INDEX_FAST="YES" 74 108 75 109 export KPP_SOLVER=Rosenbrock … … 77 111 # get Command line option 78 112 79 echo xxxxxxxxxx 80 while getopts :d:ifkp:o:s:v:w: c # get options 113 while getopts :m:i:fkup:o:s:vl:w: c # get options 81 114 do case $c in 82 d) DEFDIR=$OPTARG;; # directory of definition files83 84 i) DE_INDEX= "YES";;# if set, deindexing115 m) MECH=$OPTARG;; # mechanism 116 117 i) DE_INDEX=$OPTARG;; # if set, deindexing 85 118 86 119 f) DE_INDEX_FAST="YES";; # if set, fast deindexing … … 92 125 p) PREFIX=$OPTARG;; # Name Prefix 93 126 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 98 134 99 135 w) WORK=$OPTARG;; # Working directory 100 136 101 137 \?) print ${0##*/} "unknown option:" $OPTARG 102 print "USAGE: ${0##*/} [ - d dir -e -k -o dir -p name -s solver -vlength -w dir ] "138 print "USAGE: ${0##*/} [ -m dir -e -k -u -o dir -p name -s solver -v -l length -w dir ] " 103 139 exit 1;; 104 140 esac … … 106 142 shift OPTIND-1 107 143 108 echo $DEFDIR 144 echo MECHANISM = $MECH 145 echo DE_INDEX = $DE_INDEX 146 echo KEEP = $KEEP 147 echo UPDT = $UPDT 148 echo MODE = $MODE 149 echo VLEN = $VLEN 109 150 110 151 DEF_PREFIX=${PREFIX}.kpp 152 DEFDIR=`pwd`/mechanisms/def_$MECH 153 echo DEFDIR = $DEFDIR 111 154 112 155 # Create or clean working directory … … 122 165 123 166 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_spk_arr "128 KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST update_rconst arr2"167 KPP_SUBROUTINE_LIST="Initialize" 168 KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST INTEGRATE Fun" 169 KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST KppSolve KppDecomp" 170 KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST Jac_SP k_arr " 171 KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST Update_RCONST ARR2" 129 172 KPP_SUBROUTINE_LIST="$KPP_SUBROUTINE_LIST initialize_kpp_ctrl error_output" 130 173 … … 149 192 150 193 # Interface ignore list 151 KPP_INTERFACE_IGNORE="waxpy wcopy" 194 KPP_INTERFACE_IGNORE=" " 195 196 echo " " 197 echo KPP_SOLVER $KPP_SOLVER 198 echo " " 152 199 153 200 case $KPP_SOLVER in … … 155 202 156 203 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;; 162 212 163 213 rosenbrock_mz) … … 167 217 rosenbrock) 168 218 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";; 170 220 171 221 kpp_lsode) … … 203 253 cp $DEFDIR/${PREFIX}.kpp . 204 254 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 258 cat >> ${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 266 EOF 267 268 # Store mechanism name in file mech_list 269 cat >> mech_list << EOF 270 ! Mechanism: $MECH 271 ! 272 EOF 273 205 274 # Run kpp 206 275 … … 240 309 done 241 310 311 echo start kp4.exe with arguments 312 echo $PREFIX $MODE $VLEN $DE_INDEX $DE_INDEX_FAST 313 242 314 $BASE/bin/kpp4palm.exe $PREFIX $MODE $VLEN $DE_INDEX $DE_INDEX_FAST 243 315 316 #Prelimanary, substitution has to be moved into kpp4palm.exe 317 if [[ $MODE = "vector" ]] 318 then 319 sed -i -e 's/phot(nphot/phot(vl_dim,nphot/g' kk_kpp.f90 320 fi 244 321 245 322 if [[ -e $OUTDIR/${OUTFILE}.f90 ]] … … 248 325 fi 249 326 cp -p kk_kpp.f90 $OUTDIR/${OUTFILE}.f90 250 #cp -p kk_kpp.f90 $MY_PWD/../SOURCE/${OUTFILE}.f90251 252 327 echo " " 253 328 echo "Write kpp module -- > " $OUTDIR/${OUTFILE}.f90 329 330 if [[ $UPDT = "YES" ]] 331 then 332 cp -p kk_kpp.f90 $DEFDIR/${OUTFILE}.f90 333 echo " " 334 echo "Write kpp module -- > " $DEFDIR/${OUTFILE}.f90 335 fi 254 336 255 337 if [[ $KEEP = "NO" ]] -
palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/create_kpp_module.C
r2768 r3298 17 17 //----------------- 18 18 //$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 $ 19 36 // Removed preprocessor directive __chem again 20 37 // 21 / 2017-09-14 13:56:42Z forkel $38 // 2017-09-14 13:56:42Z forkel $ 22 39 // 23 40 // … … 25 42 //change of some output to lowercase with uppercase Fortran 26 43 // 27 // Nov 2016: Intial version (Klaus Ketelsen)44 // Nov 2016: Intial version of KP4 adapted to PALM (Klaus Ketelsen) 28 45 // 29 46 … … 49 66 cout << "Create " << module_name << " from kpp Fortran sources" <<endl; 50 67 cout << "Vector mode " << kpp_switches.is_vector() <<endl; 68 cout << "De_indexing " << kpp_switches.de_indexing() <<endl; 51 69 52 70 create_fortran_files_and_read(); 53 cout << "## after create_fortran_files_and_read " <<endl;54 71 55 72 // Generate first module lines 56 73 57 74 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(" "); 62 77 63 78 // string e5_line = first_line +"_e5"; … … 93 108 it->edit_fortran (); 94 109 } 95 cout << "## after edit FORTRAN files " <<endl;96 110 97 111 // Generate a list of single subroutines from kpp-files … … 109 123 } 110 124 111 112 if(kpp_switches.is_vector()) { 113 125 if(kpp_switches.is_vector()) { 126 127 cout << "##### Hier kpp_switches.is_vector " <<endl; 114 128 // Change header section 115 129 for(it=kpp_includes.begin();it!=kpp_includes.end();it++) { … … 138 152 it->edit_Fun(); 139 153 } 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; 142 165 143 166 } … … 146 169 147 170 for(it=kpp_subroutines.begin();it!=kpp_subroutines.end();it++) { 148 if(it->get_name() == " update_rconst") {171 if(it->get_name() == "Update_RCONST") { 149 172 it->edit_Update_RCONST(Vvar_list); 150 173 } 174 175 if(it->get_name() == "Initialize") { 176 it->edit_Initialize(Vvar_list); 177 } 178 151 179 } 152 180 … … 184 212 } 185 213 186 buf = prefix + " INTERFACE" + it->get_name() ;214 buf = prefix + "interface " + it->get_name() ; 187 215 mz_kpp.add_line(buf); 188 buf = prefix + " MODULE PROCEDURE" + it->get_name();216 buf = prefix + " module procedure " + it->get_name(); 189 217 mz_kpp.add_line(buf); 190 buf = prefix + " END INTERFACE" + it->get_name();218 buf = prefix + "end interface " + it->get_name(); 191 219 mz_kpp.add_line(buf); 192 220 mz_kpp.add_line(" "); 193 221 } 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 }208 222 209 223 mz_kpp.add_line(" "); 210 224 211 for(iv=Vvar_list.begin();iv!=Vvar_list.end();iv++) {212 create_fill_routine(kpp_subroutines, *iv);213 }214 225 215 226 // Copy FORTRAN subroutines to mz_kpp … … 224 235 // Finish module 225 236 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); 241 240 242 241 // Write the complete module to file: mz_kpp.f … … 376 375 string diline; 377 376 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 378 394 // Read Modul Header from file $MZ_KPP_HOME/templates/module_header 379 395 … … 394 410 mz_kpp.add_line(" "); 395 411 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. "); 399 415 } 400 416 // mz_pj_20070531+ 401 417 sprintf(distr,"%i",kpp_switches.de_indexing()); 402 418 diline = distr ; 403 mz_kpp.add_line(" INTEGER, PARAMETER :: i_lu_di= " + diline );419 mz_kpp.add_line(" integer,parameter :: I_LU_DI = " + diline ); 404 420 // mz_pj_20070531- 405 421 406 mz_kpp.add_line(" INTEGER, PARAMETER :: vl_dim= "407 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 "); 409 425 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 "); 412 428 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 417 434 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();432 435 433 436 return; … … 448 451 out.close(); 449 452 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();459 453 460 454 return; … … 468 462 kppi.set_name("chem_gasphase_integrate"); 469 463 470 kppi.add_line("SUBROUTINE chem_gasphase_integrate (time_step_len, conc, temp k, 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 ) "); 471 465 kppi.add_line(" "); 472 466 kppi.add_line(" IMPLICIT NONE "); 473 467 kppi.add_line(" "); 474 468 475 kppi.add_line(" REAL(dp), INTENT(IN):: time_step_len ");469 kppi.add_line(" REAL(dp), INTENT(IN) :: time_step_len "); 476 470 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 "); 485 483 kppi.add_line(" "); 486 484 kppi.add_line(" INTEGER :: k ! loop variable "); 487 485 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 "); 498 500 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) "); 500 502 kppi.add_line(" vl = ie-is+1 "); 501 503 502 504 kppi.add_line(" "); 503 505 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 514 533 kppi.add_line(" "); 515 534 if(kpp_switches.is_vector()) { … … 528 547 kppi.add_line(" "); 529 548 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(:) "); 536 556 } 537 557 … … 540 560 kppi.add_line(" "); 541 561 if(kpp_switches.is_vector()) { 542 kppi.add_line(" if(P RESENT(ierrf)) ierrf(is:ie) = ierrv(1:vl) ");543 kppi.add_line(" if(P RESENT(xnacc)) xnacc(is:ie) = kacc(1:vl) ");544 kppi.add_line(" if(P RESENT(xnrej)) xnrej(is:ie) = krej(1:vl) ");545 } else { 546 kppi.add_line(" if(P RESENT(ierrf)) ierrf(is) = ierr_u");547 kppi.add_line(" if(P RESENT(xnacc)) xnacc(is) = istatus_u(4) ");548 kppi.add_line(" if(P RESENT(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)) "); 555 575 kppi.add_line(" istatus(3) = istatus(4) + istatus(5) "); 556 576 kppi.add_line(" istatus(6) = istatus(6) + istatus_u(6) "); … … 559 579 kppi.add_line(" istatus(1:8) = istatus(1:8) + istatus_u(1:8) "); 560 580 } 561 kppi.add_line(" ENDIF");581 kppi.add_line(" end if "); 562 582 kppi.add_line(" "); 563 583 kppi.add_line(" END DO "); … … 568 588 kppi.add_line(" "); 569 589 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 +" ) "); 571 591 } 572 592 … … 574 594 kppi.add_line(" data_loaded = .false. "); 575 595 kppi.add_line(" "); 576 kppi.add_line(" RETURN");596 kppi.add_line(" return "); 577 597 kppi.add_line("END SUBROUTINE chem_gasphase_integrate "); 578 598 … … 583 603 } 584 604 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 1 1 #ifndef mecca 2 #define mecca 1 2 // ketelsen 18.09.2018: Removed create_fill_routine 3 3 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 13 19 14 20 #include <iostream> … … 48 54 49 55 void create_kpp_integrate(); 50 void create_fill_routine(vector<fortran_file> &e5_list, Vvar &var ); 51 56 57 public: 52 58 53 59 void do_work (string s) ; -
palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/expand_decomp.C
r2696 r3298 165 165 vector<fortran_file>::iterator it; 166 166 fortran_file de; 167 int k,kk,j,jj,i ,ii;167 int k,kk,j,jj,i; 168 168 string line; 169 169 char cline[80]; -
palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/fortran_file.C
r2696 r3298 13 13 //Current revisions: 14 14 //------------------ 15 / /16 / /15 / 16 / 17 17 //Former revisions: 18 18 //----------------- 19 19 //$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 $ 20 30 // 21 31 // … … 26 36 // 27 37 // 28 // Nov 2016: Intial version (Klaus Ketelsen)38 // Nov 2016: Intial version of KP4 adapted to PALM (Klaus Ketelsen) 29 39 // 30 40 … … 62 72 } 63 73 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 67 94 if(line.substr(0,2) =="! ") { 68 95 global_substitute(line,"#","#"); // just a dummy so comments do not get lost … … 77 104 global_substitute(line,"/JVS","/ JVS"); 78 105 global_substitute(line,"-","- "); 79 global_substitute(line,"e- ","e-");80 106 global_substitute(line,"+","+ "); 81 107 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 } 123 109 } 124 110 … … 167 153 // Update_RCONST has only to be called once per outer timeloop in KPP_FOR_PALM 168 154 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" ) { 171 156 lo_line.insert(0,"!DELETE "); 172 157 cout << lo_line << endl; … … 175 160 // Update_SUN must not be called within in KPP_FOR_PALM 176 161 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") { 179 170 lo_line.insert(0,"!DELETE "); 180 171 cout << lo_line << endl; … … 338 329 } 339 330 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 340 420 // Make ind_ variables public 341 421 if(ip->get_token(3).substr(0,4) == "ind_") { … … 464 544 to_do = false; 465 545 } 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 470 558 if(to_do || todo_1) { 471 559 if(ip->get_token(0).substr(0,1) == "!") continue; // skip comment limes … … 499 587 cout << "Vector variable " << ip->get_token(pos+1) <<" " << vari.nr_dim() <<endl; 500 588 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 } 516 609 } 517 610 ip->set_line(lo_line); … … 541 634 542 635 vector<program_line>::iterator ip; 636 program_line pl; 543 637 string lo_line; 638 string line; 544 639 545 640 for (ip=pline.begin(); ip != pline.end(); ip++) { … … 555 650 ip->global_substitute("* ","*"); 556 651 ip->global_substitute("* ","*"); 557 558 652 // ip->global_substitute("d- ","d-"); 653 // ip->global_substitute("d+ ","d+"); 559 654 ip->global_substitute(", ",","); 560 655 ip->global_substitute(")=",") ="); … … 562 657 ip->global_substitute(", - ",", -"); 563 658 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 564 757 // line break if more than 130 character 565 758 566 759 // lo_line = ip->get_line(); 567 760 if( lo_line.size() < 130 ) { 568 out << ip->get_line() <<endl; 761 // out << ip->get_line() <<endl; 762 out << lo_line <<endl; 569 763 } else { 570 764 int cp = lo_line.rfind("!",129); -
palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/fortran_file.h
r2696 r3298 12 12 // ############################################################################ 13 13 // 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 16 26 17 27 #include <iostream> … … 42 52 void edit_KppSolve () ; 43 53 void edit_Fun () ; 54 void edit_WAXPY () ; 55 void edit_FunTemplate () ; 56 void edit_JacTemplate () ; 44 57 void edit_FUNC () ; 45 58 void edit_Update_RCONST (vector <Vvar> &var_list) ; 59 void edit_Initialize (vector <Vvar> &var_list) ; 46 60 void edit_inc (fortran_file & header_var) ; 47 61 void create_species_list(vector <string> &species_list); -
palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/src/fortran_file_vec.C
r2696 r3298 9 9 // 10 10 // ############################################################################ 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 11 28 12 29 #include <fstream> … … 77 94 } 78 95 } 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 79 103 ip = pline.begin()+1 ; 80 104 lo_line = ip->get_line() ; 81 105 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 } 83 111 ip->set_line(lo_line); 84 112 … … 87 115 lo_line = ip->get_line() ; 88 116 lo_line.erase(); 89 lo_line = " do k= is,ie";117 lo_line = " do k=1,vl"; 90 118 ip->set_line(lo_line); 91 119 … … 93 121 lo_line = ip->get_line() ; 94 122 lo_line.erase(); 95 lo_line = " j = k -is+1";123 lo_line = " j = k"; 96 124 ip->set_line(lo_line); 97 125 … … 103 131 } else { 104 132 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 142 void 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 ; 105 197 lo_line = ip->get_line() ; 106 198 lo_line.erase(); … … 236 328 } 237 329 330 void 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 360 void 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 380 void 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 134 134 return; 135 135 } 136 void program_line::global_subtolower(string &line) { 136 137 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 11 11 // 12 12 // ############################################################################ 13 // 14 // forkel June 2018: added void global_subtolower(string &line); 13 15 14 16 #include <iostream> … … 42 44 void change_variable_to_vector (string var); 43 45 void change_variable_to_vector_g (Vvar &var); 46 void global_subtolower(string &line); 44 47 }; 45 48 -
palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/templates/initialize_kpp_ctrl_template.f90
r2696 r3298 32 32 CONTAINS 33 33 34 SUBROUTINE initialize_kpp_ctrl(status , iou, modstr)34 SUBROUTINE initialize_kpp_ctrl(status) 35 35 36 36 IMPLICIT NONE … … 38 38 ! I/O 39 39 INTEGER, INTENT(OUT) :: status 40 INTEGER, INTENT(IN) :: iou ! logical I/O unit41 CHARACTER(LEN=*), INTENT(IN) :: modstr ! read <modstr>.nml42 40 43 41 ! LOCAL -
palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/templates/module_header
r2718 r3298 3 3 ! ****** Module chem_gasphase_mod is automatically generated by kpp4palm ****** 4 4 ! 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. 6 23 ! 7 24 !------------------------------------------------------------------------------! … … 30 47 ! ----------------- 31 48 ! $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 32 54 ! 33 ! 34 ! Variables for photolyis added 35 ! 36 ! 37 ! 55 ! forkel Sept. 2017: Variables for photolyis added 38 56 ! 39 57 ! … … 64 82 PUBLIC :: nspec, nreact 65 83 PUBLIC :: temp 84 PUBLIC :: qvap 85 PUBLIC :: fakt 66 86 PUBLIC :: phot 67 87 PUBLIC :: rconst 68 88 PUBLIC :: nvar 69 89 PUBLIC :: nphot 90 PUBLIC :: vl_dim ! Public to ebable other modules to distiguish between scalar and vec 70 91 71 PUBLIC :: initialize, integrate, update_rconst92 PUBLIC :: Initialize, Integrate, Update_rconst 72 93 PUBLIC :: chem_gasphase_integrate 73 94 PUBLIC :: initialize_kpp_ctrl
Note: See TracChangeset
for help on using the changeset viewer.
