├── .gitignore ├── bin └── .gitignore ├── tmp └── .gitignore ├── output └── .gitignore ├── src ├── OBJ │ └── .gitignore ├── make_chempp ├── Base_Srclist_f ├── cam_chempp │ ├── prd_map.f │ ├── slt_hdr.f │ ├── files_hdr.f │ ├── make_map.f │ ├── het_names.f │ ├── res_hdr.f │ ├── params_hdr.f │ ├── tokens.f │ ├── rxt_names.f │ ├── make_names.f │ ├── sub_scan.f │ ├── exe_opts.f │ ├── srfflx.f │ ├── job_ctl.f │ ├── usrsubs.f │ ├── num_ctl.f │ ├── spat_dim.f │ ├── sparse_pat.f │ ├── bndy_conds.f │ ├── hist_inp.f │ ├── ver_hdr.f │ ├── chm_hdr.f │ ├── sol_cls.f │ ├── padj_code.f │ ├── rmod_code.f │ ├── rate_tab.f │ ├── rxt_equations.f │ ├── outp.f │ └── mak_grp_vmr.f └── Makefile ├── bkend ├── mozart.mat.files.PP ├── mozart.mod.files.PP ├── cam.mod.files.PP ├── wrf.mod.files.PP ├── cam.src.files.PP └── mozart.src.files.PP ├── README ├── procfiles ├── mo_grid.mod ├── cam │ ├── mo_chem.mod │ ├── mo_exp_sol_scalar.F90 │ └── mo_exp_sol_vector.F90 └── mo_chem.mod └── inputs ├── cam_co_prescribed.inp ├── cam_bc.inp ├── cam_fixed_oxidants.inp ├── cam_fixed_aerosols.inp ├── cam_fixed_aerosols_ozone.inp ├── cam_fixed_aerosols_run6.inp ├── prog_carbon_sulfate.inp ├── ghg_fixed_aerosols.inp ├── modal_aerosols_3mode_aerocom.in ├── modal_aerosols_3mode.in ├── cam_fixed_oxidants_aerosols.inp ├── modal_aerosols_7mode.in ├── cam_fixed_oxidants_modal_aero_cw_3modes_0707.inp ├── cam_TP1.inp ├── super_fast_LLNL.tuv.in ├── super_fast_LLNL.lut.in ├── cam_fixed_oxidants_modal_aero_cw_7modes_noaerwater.inp ├── super_fast_LLNL.in ├── super_fast_LLNL.lut.fixed_ch4.in ├── super_fast_LLNL.lut.fixed_ch4.isoprene+O3.in ├── cam_TP1.v2.inp ├── super_fast_modal_3modes.in └── kmg_CAM3_input_deck_T6_v4.inp /.gitignore: -------------------------------------------------------------------------------- 1 | campp 2 | OBJ/ 3 | bin/ 4 | *.mod 5 | -------------------------------------------------------------------------------- /bin/.gitignore: -------------------------------------------------------------------------------- 1 | # Ignore everything in this directory 2 | * 3 | # Except this file 4 | !.gitignore 5 | -------------------------------------------------------------------------------- /tmp/.gitignore: -------------------------------------------------------------------------------- 1 | # Ignore everything in this directory 2 | * 3 | # Except this file 4 | !.gitignore 5 | -------------------------------------------------------------------------------- /output/.gitignore: -------------------------------------------------------------------------------- 1 | # Ignore everything in this directory 2 | * 3 | # Except this file 4 | !.gitignore 5 | -------------------------------------------------------------------------------- /src/OBJ/.gitignore: -------------------------------------------------------------------------------- 1 | # Ignore everything in this directory 2 | * 3 | # Except this file 4 | !.gitignore 5 | -------------------------------------------------------------------------------- /bkend/mozart.mat.files.PP: -------------------------------------------------------------------------------- 1 | # include 2 | # include 3 | # include 4 | prd_loss.F 5 | indprd.F 6 | linmat.F 7 | nlnmat.F 8 | lu_fac.F 9 | lu_slv.F 10 | -------------------------------------------------------------------------------- /bkend/mozart.mod.files.PP: -------------------------------------------------------------------------------- 1 | # include 2 | # include 3 | # include 4 | # include 5 | # include 6 | MODSPATH/mo_grid.mod 7 | MODSPATH/mo_chem.mod 8 | -------------------------------------------------------------------------------- /src/make_chempp: -------------------------------------------------------------------------------- 1 | #!/bin/csh 2 | 3 | set exenam=../bin/campp 4 | set objdir=OBJ 5 | 6 | rm -f $exenam 7 | rm -f $objdir/* 8 | 9 | gmake USER_FC=gfortran DEBUG=TRUE EXENAME=$exenam 10 | -------------------------------------------------------------------------------- /bkend/cam.mod.files.PP: -------------------------------------------------------------------------------- 1 | # include 2 | # include 3 | # include 4 | # include 5 | # include 6 | #if defined(MOZART) 7 | MODSPATH/mo_grid.mod 8 | #endif 9 | MODSPATH/mo_chem.mod 10 | -------------------------------------------------------------------------------- /bkend/wrf.mod.files.PP: -------------------------------------------------------------------------------- 1 | # include 2 | # include 3 | # include 4 | # include 5 | # include 6 | #if defined(MOZART) 7 | MODSPATH/mo_grid.mod 8 | #endif 9 | MODSPATH/mo_chem.mod 10 | -------------------------------------------------------------------------------- /bkend/cam.src.files.PP: -------------------------------------------------------------------------------- 1 | # include 2 | # include 3 | # include 4 | # include 5 | # if defined(RXTNLOOKUP) && TDEPCNT != 0 6 | rxttab.F 7 | # endif 8 | SETRXTFILE 9 | ADJRXTFILE 10 | PHTADJFILE 11 | SETDATFILE 12 | -------------------------------------------------------------------------------- /bkend/mozart.src.files.PP: -------------------------------------------------------------------------------- 1 | # include 2 | # include 3 | # include 4 | # include 5 | # if defined(RXTNLOOKUP) && TDEPCNT != 0 6 | rxttab.F 7 | # endif 8 | SETRXTFILE 9 | ADJRXTFILE 10 | PHTADJFILE 11 | RXTMODFILE 12 | GRPVMRFILE 13 | -------------------------------------------------------------------------------- /src/Base_Srclist_f: -------------------------------------------------------------------------------- 1 | mozpp.mods.f 2 | mass_diags.f 3 | make_lu_slv.f 4 | res_hdr.f 5 | chm_hdr.f 6 | make_names.f 7 | slt_hdr.f 8 | eqrep.f 9 | rxt_equations.f 10 | sol_cls.f 11 | hist_hdr.f 12 | exe_opts.f 13 | sp_utils.f 14 | mozpp.subs.f 15 | sparse_pat.f 16 | files_hdr.f 17 | params_hdr.f 18 | hist_inp.f 19 | nln_code.f 20 | spat_dim.f 21 | hist_out.f 22 | num_ctl.f 23 | srfflx.f 24 | ipd_code.f 25 | padj_code.f 26 | sub_scan.f 27 | pl_code.f 28 | symbol.f 29 | job_ctl.f 30 | prd_map.f 31 | tokens.f 32 | lin_code.f 33 | radj_code.f 34 | usrsubs.f 35 | mak_grp_vmr.f 36 | rate_code.f 37 | ver_hdr.f 38 | make_lu_fac.f 39 | rate_tab.f 40 | ver_opts.f 41 | rxt_names.f 42 | het_names.f 43 | chem.f 44 | make_map.f 45 | rmod_code.f 46 | cls_map.f 47 | bndy_conds.f 48 | make_sim_dat.f 49 | mozpp.main.f 50 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | 2 | This is the MOZART chemical preprocessor, which has been modified for the 3 | CAM framework. 4 | 5 | This tool creates CAM chemistry source code files (fortran) for a given 6 | chemical mechanism file (*.inp file). 7 | 8 | Here $PROC_DIR is the top level directory of the chemical preprocessor. 9 | 10 | To build: 11 | > cd $PROC_DIR/src 12 | > gmake 13 | This will biuld $PROC_DIR/bin/campp executable. 14 | 15 | Edit or create a chemical mechanism file in the $PROC_DIR/inputs 16 | directory. Example mechanisms files can be found in $PROC_DIR/inputs. 17 | More information the chemical mechanism inputs can be found at 18 | https://github.com/ESCOMP/CHEM_PREPROCESSOR/wiki 19 | 20 | To run: 21 | > cd $PROC_DIR/inputs 22 | > $PROC_DIR/bin/campp mechanism.inp 23 | > cd $PROC_DIR/output 24 | > cp cam.subs.tar $CAM_USRSRC 25 | > cd $CAM_USRSRC 26 | > tar -xvf cam.subs.tar 27 | 28 | Include the fortran source files extacted from cam.subs.tar in the 29 | source path of the CAM build by one of the follow methods. 30 | 1) configure CAM with the -usr_src $CAM_USRSRC option 31 | or 32 | 2) copy the new *.F90 files to the trop_mozart directory 33 | 34 | Configure and build the new CAM executable. 35 | -------------------------------------------------------------------------------- /src/cam_chempp/prd_map.f: -------------------------------------------------------------------------------- 1 | 2 | module MO_PRD_MAP 3 | 4 | CONTAINS 5 | 6 | subroutine PRD_MAP( template ) 7 | !----------------------------------------------------------------------- 8 | ! ... Form production indicies 9 | !----------------------------------------------------------------------- 10 | 11 | use VAR_MOD, only : var_lim 12 | use RXT_MOD, only : prd_lim 13 | 14 | implicit none 15 | 16 | !----------------------------------------------------------------------- 17 | ! ... Dummy args 18 | !----------------------------------------------------------------------- 19 | integer, intent(inout) :: template(:,:) 20 | 21 | !----------------------------------------------------------------------- 22 | ! ... Local variables 23 | !----------------------------------------------------------------------- 24 | integer :: i, clsno 25 | 26 | integer :: XLATE 27 | 28 | template(:,:2) = 0 29 | 30 | do i = 1,prd_lim 31 | if( template(i,3) < 0 ) then 32 | cycle 33 | else if( template(i,3) == 0 ) then 34 | exit 35 | else 36 | clsno = XLATE( template(i,3) ) 37 | template(i,2) = clsno 38 | template(clsno,1) = template(clsno,1) + 1 39 | end if 40 | end do 41 | 42 | end subroutine PRD_MAP 43 | 44 | end module MO_PRD_MAP 45 | -------------------------------------------------------------------------------- /procfiles/mo_grid.mod: -------------------------------------------------------------------------------- 1 | 2 | module mo_grid 3 | !--------------------------------------------------------------------- 4 | ! ... Basic grid point resolution parameters 5 | !--------------------------------------------------------------------- 6 | implicit none 7 | 8 | save 9 | 10 | integer, parameter :: & 11 | pcnst = PCNST+1, & ! number of advected constituents including cloud water 12 | pcnstm1 = PCNST, & ! number of advected constituents excluding cloud water 13 | plev = PLEV, & ! number of vertical levels 14 | plevp = plev+1, & ! plev plus 1 15 | plevm = plev-1, & ! plev minus 1 16 | plon = PLON, & ! number of longitudes 17 | plat = PLAT ! number of latitudes 18 | 19 | integer, parameter :: & 20 | pnats = GRPCNT ! number of non-advected trace species 21 | 22 | #ifdef STRAT_CHEM 23 | integer, parameter :: & 24 | phmu = PCNST ! number of long-lived species 25 | #endif 26 | 27 | integer :: nodes ! mpi task count 28 | integer :: plonl ! longitude tile dimension 29 | integer :: pplon ! longitude tile count 30 | integer :: plnplv ! plonl * plev 31 | 32 | end module mo_grid 33 | -------------------------------------------------------------------------------- /inputs/cam_co_prescribed.inp: -------------------------------------------------------------------------------- 1 | BEGSIM 2 | output_unit_number = 7 3 | output_file = co2.doc 4 | sim_dat_filename = sim.dat 5 | procout_path = ../output/ 6 | src_path = ../bkend/ 7 | procfiles_path = ../procfiles/cam/ 8 | sim_dat_path = ../output/ 9 | 10 | Comments 11 | "This is a mozart2 simulation with :" 12 | "(1) The new Lin and Rood advection routine" 13 | End Comments 14 | 15 | SPECIES 16 | 17 | Solution 18 | CO 19 | End Solution 20 | 21 | Fixed 22 | M, N2, O2, H2O, OH 23 | End Fixed 24 | 25 | Col-int 26 | O2 = 0. 27 | End Col-int 28 | 29 | End SPECIES 30 | 31 | Solution Classes 32 | Explicit 33 | CO 34 | End Explicit 35 | Implicit 36 | End Implicit 37 | End Solution Classes 38 | 39 | CHEMISTRY 40 | 41 | Reactions 42 | [usr8] CO + OH -> CO2 + HO2 43 | End Reactions 44 | 45 | Ext Forcing 46 | CO<-dataset 47 | End Ext Forcing 48 | 49 | 50 | END CHEMISTRY 51 | 52 | SIMULATION PARAMETERS 53 | 54 | Version Options 55 | model = cam 56 | machine = Intel 57 | architecture = hybrid 58 | vec_ftns = on 59 | multitask = on 60 | namemod = on 61 | modules = on 62 | End Version Options 63 | 64 | END SIMULATION PARAMETERS 65 | 66 | ENDSIM 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | -------------------------------------------------------------------------------- /inputs/cam_bc.inp: -------------------------------------------------------------------------------- 1 | BEGSIM 2 | output_unit_number = 7 3 | output_file = bc.doc 4 | sim_dat_filename = sim.dat 5 | procout_path = ../output/ 6 | src_path = ../bkend/ 7 | procfiles_path = ../procfiles/cam/ 8 | sim_dat_path = ../output/ 9 | 10 | Comments 11 | "This is a mozart2 simulation with :" 12 | "(1) The new Lin and Rood advection routine" 13 | End Comments 14 | 15 | SPECIES 16 | 17 | Solution 18 | CB1 -> C, CB2 -> C 19 | End Solution 20 | 21 | Fixed 22 | M, N2, O2 23 | End Fixed 24 | 25 | Col-int 26 | O2 = 0. 27 | End Col-int 28 | 29 | End SPECIES 30 | 31 | Solution Classes 32 | Explicit 33 | End Explicit 34 | Implicit 35 | CB1,CB2 36 | End Implicit 37 | End Solution Classes 38 | 39 | CHEMISTRY 40 | 41 | Reactions 42 | CB1 -> CB2 ; 7.1e-6 43 | End Reactions 44 | 45 | Ext Forcing 46 | End Ext Forcing 47 | 48 | 49 | END CHEMISTRY 50 | 51 | SIMULATION PARAMETERS 52 | 53 | Version Options 54 | model = cam 55 | machine = Intel 56 | architecture = hybrid 57 | vec_ftns = on 58 | multitask = on 59 | namemod = on 60 | modules = on 61 | End Version Options 62 | 63 | END SIMULATION PARAMETERS 64 | 65 | ENDSIM 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | -------------------------------------------------------------------------------- /src/cam_chempp/slt_hdr.f: -------------------------------------------------------------------------------- 1 | subroutine SLT_HDR( cray, & 2 | multitask, & 3 | cpucnt, & 4 | machine ) 5 | 6 | implicit none 7 | 8 | !----------------------------------------------------------------------- 9 | ! ... The arguments 10 | !----------------------------------------------------------------------- 11 | integer, intent(in) :: cpucnt 12 | logical, intent(in) :: cray 13 | logical, intent(in) :: multitask 14 | character(len=16), intent(in) :: machine 15 | 16 | !----------------------------------------------------------------------- 17 | ! ... The local variables 18 | !----------------------------------------------------------------------- 19 | logical :: lexist 20 | 21 | INQUIRE( file = 'slt.h', exist = lexist ) 22 | if( lexist ) then 23 | call SYSTEM( 'rm slt.h' ) 24 | end if 25 | OPEN( unit = 30, file = 'slt.h' ) 26 | 27 | if( cray .and. multitask ) then 28 | write(30,'(''# define MT'')') 29 | else if( .not. cray ) then 30 | write(30,'(''# define NOCRAY'')') 31 | write(30,'(''# define PORT'')') 32 | if( multitask ) then 33 | write(30,'(''# define MPP'')') 34 | write(30,'(''# define NCPUS '',i3)') cpucnt 35 | end if 36 | end if 37 | write(30,'(''# define '',a8)') machine 38 | 39 | CLOSE(30) 40 | 41 | end subroutine SLT_HDR 42 | -------------------------------------------------------------------------------- /src/cam_chempp/files_hdr.f: -------------------------------------------------------------------------------- 1 | 2 | module mo_files_hdr 3 | 4 | use io, only : temp_path, procfiles_path 5 | 6 | contains 7 | 8 | subroutine files_hdr 9 | 10 | implicit none 11 | 12 | !----------------------------------------------------------------------- 13 | ! ... The local variables 14 | !----------------------------------------------------------------------- 15 | integer :: slen 16 | logical :: lexist 17 | 18 | inquire( file = 'files.h', exist = lexist ) 19 | if( lexist ) then 20 | call system( 'rm files.h' ) 21 | end if 22 | open( unit = 30, file = 'files.h' ) 23 | 24 | write(30,'(''#define SETRXTFILE '',a)') TRIM( temp_path ) // 'mo_setrxt.F' 25 | write(30,'(''#define ADJRXTFILE '',a)') TRIM( temp_path ) // 'mo_adjrxt.F' 26 | write(30,'(''#define PHTADJFILE '',a)') TRIM( temp_path ) // 'mo_phtadj.F' 27 | write(30,'(''#define RXTMODFILE '',a)') TRIM( temp_path ) // 'mo_rxt_mod.F' 28 | write(30,'(''#define GRPVMRFILE '',a)') TRIM( temp_path ) // 'mo_make_grp_vmr.F' 29 | write(30,'(''#define SETDATFILE '',a)') TRIM( temp_path ) // 'mo_sim_dat.F' 30 | slen = len_trim( procfiles_path ) 31 | write(30,'(''#define EXPSLVPATH '',a)') procfiles_path(:slen-1) 32 | write(30,'(''#define IMPSLVPATH '',a)') procfiles_path(:slen-1) 33 | write(30,'(''#define MODSPATH '',a)') procfiles_path(:slen-1) 34 | 35 | close(30) 36 | 37 | end subroutine files_hdr 38 | 39 | end module mo_files_hdr 40 | -------------------------------------------------------------------------------- /inputs/cam_fixed_oxidants.inp: -------------------------------------------------------------------------------- 1 | BEGSIM 2 | output_unit_number = 7 3 | output_file = cam_fixed_oxidants.doc 4 | procout_path = ../output/ 5 | src_path = ../bkend/ 6 | procfiles_path = ../procfiles/cam/ 7 | sim_dat_path = ../output/ 8 | sim_dat_filename = cam_fixed_oxidants.dat 9 | 10 | Comments 11 | "This is a mozart4 simulation with :" 12 | "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)" 13 | "(2) New aerosol chemistry" 14 | "(3) No groups" 15 | "(4) NCEP inputs (28 levels)" 16 | "(5) no N atom; no NH4, no H2SO4" 17 | End Comments 18 | 19 | SPECIES 20 | 21 | Solution 22 | H2O2, SO2, SO4, DMS -> CH3SCH3 23 | End Solution 24 | 25 | Fixed 26 | M, N2, O2, H2O, O3, OH, NO3, HO2 27 | End Fixed 28 | 29 | Col-int 30 | O3 = 0. 31 | O2 = 0. 32 | End Col-int 33 | 34 | End SPECIES 35 | 36 | Solution Classes 37 | Explicit 38 | End Explicit 39 | Implicit 40 | H2O2, SO2, SO4, DMS 41 | End Implicit 42 | End Solution Classes 43 | 44 | CHEMISTRY 45 | Photolysis 46 | End Photolysis 47 | 48 | Reactions 49 | End Reactions 50 | 51 | Ext Forcing 52 | End Ext Forcing 53 | 54 | END CHEMISTRY 55 | 56 | SIMULATION PARAMETERS 57 | 58 | Version Options 59 | model = cam 60 | machine = intel 61 | architecture = hybrid 62 | vec_ftns = on 63 | multitask = on 64 | namemod = on 65 | modules = on 66 | End Version Options 67 | 68 | END SIMULATION PARAMETERS 69 | 70 | ENDSIM 71 | -------------------------------------------------------------------------------- /src/cam_chempp/make_map.f: -------------------------------------------------------------------------------- 1 | 2 | module MO_MAKE_MAP 3 | 4 | CONTAINS 5 | 6 | subroutine MAKE_MAP( cls_rxt_map, & 7 | cls_rxt_cnt, & 8 | clsno, & 9 | rxno, & 10 | cls_prd_cnt, & 11 | template ) 12 | 13 | use RXT_MOD, only : rxt_lim, prd_lim 14 | 15 | implicit none 16 | 17 | !------------------------------------------------------------------------ 18 | ! ... Dummy args 19 | !------------------------------------------------------------------------ 20 | integer, intent(in) :: clsno, rxno, cls_prd_cnt 21 | integer, intent(in) :: template(:,:) 22 | integer, intent(inout) :: cls_rxt_cnt 23 | integer, intent(inout) :: cls_rxt_map(:) 24 | 25 | !------------------------------------------------------------------------ 26 | ! ... Local variables 27 | !------------------------------------------------------------------------ 28 | integer :: count 29 | integer :: k, kp3 30 | 31 | count = 0 32 | cls_rxt_cnt = cls_rxt_cnt + 1 33 | cls_rxt_map(1) = rxno 34 | do k = 1,prd_lim 35 | kp3 = k + 3 36 | if( template(k,2) == clsno ) then 37 | count = count + 1 38 | cls_rxt_map(kp3) = template(k,3) 39 | if( count == cls_prd_cnt ) then 40 | exit 41 | end if 42 | else 43 | cls_rxt_map(kp3) = -huge(0) 44 | end if 45 | end do 46 | 47 | end subroutine MAKE_MAP 48 | 49 | end module MO_MAKE_MAP 50 | -------------------------------------------------------------------------------- /inputs/cam_fixed_aerosols.inp: -------------------------------------------------------------------------------- 1 | BEGSIM 2 | output_unit_number = 7 3 | output_file = cam_fixed_oxidants.doc 4 | procout_path = ../output/ 5 | src_path = ../bkend/ 6 | procfiles_path = ../procfiles/cam/ 7 | sim_dat_path = ../output/ 8 | sim_dat_filename = cam_fixed_oxidants.dat 9 | 10 | Comments 11 | "This is a mozart4 simulation with :" 12 | "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)" 13 | "(2) New aerosol chemistry" 14 | "(3) No groups" 15 | "(4) NCEP inputs (28 levels)" 16 | "(5) no N atom; no NH4, no H2SO4" 17 | End Comments 18 | 19 | SPECIES 20 | 21 | Solution 22 | End Solution 23 | 24 | Fixed 25 | M, N2, O2, H2O, SO4, CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C 26 | SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl 27 | DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5 28 | End Fixed 29 | 30 | Col-int 31 | O3 = 0. 32 | O2 = 0. 33 | End Col-int 34 | 35 | End SPECIES 36 | 37 | Solution Classes 38 | Explicit 39 | End Explicit 40 | Implicit 41 | End Implicit 42 | End Solution Classes 43 | 44 | CHEMISTRY 45 | Photolysis 46 | End Photolysis 47 | 48 | Reactions 49 | End Reactions 50 | 51 | Ext Forcing 52 | End Ext Forcing 53 | 54 | END CHEMISTRY 55 | 56 | SIMULATION PARAMETERS 57 | 58 | Version Options 59 | model = cam 60 | machine = intel 61 | architecture = hybrid 62 | vec_ftns = on 63 | multitask = on 64 | namemod = on 65 | modules = on 66 | End Version Options 67 | 68 | END SIMULATION PARAMETERS 69 | 70 | ENDSIM 71 | -------------------------------------------------------------------------------- /inputs/cam_fixed_aerosols_ozone.inp: -------------------------------------------------------------------------------- 1 | BEGSIM 2 | output_unit_number = 7 3 | output_file = cam_fixed_oxidants.doc 4 | procout_path = ../output/ 5 | src_path = ../bkend/ 6 | procfiles_path = ../procfiles/cam/ 7 | sim_dat_path = ../output/ 8 | sim_dat_filename = cam_fixed_oxidants.dat 9 | 10 | Comments 11 | "This is a mozart4 simulation with :" 12 | "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)" 13 | "(2) New aerosol chemistry" 14 | "(3) No groups" 15 | "(4) NCEP inputs (28 levels)" 16 | "(5) no N atom; no NH4, no H2SO4" 17 | End Comments 18 | 19 | SPECIES 20 | 21 | Solution 22 | End Solution 23 | 24 | Fixed 25 | M, N2, O2, H2O, SO4, CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C 26 | SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl 27 | DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5 28 | O3 29 | End Fixed 30 | 31 | Col-int 32 | O3 = 0. 33 | O2 = 0. 34 | End Col-int 35 | 36 | End SPECIES 37 | 38 | Solution Classes 39 | Explicit 40 | End Explicit 41 | Implicit 42 | End Implicit 43 | End Solution Classes 44 | 45 | CHEMISTRY 46 | Photolysis 47 | End Photolysis 48 | 49 | Reactions 50 | End Reactions 51 | 52 | Ext Forcing 53 | End Ext Forcing 54 | 55 | END CHEMISTRY 56 | 57 | SIMULATION PARAMETERS 58 | 59 | Version Options 60 | model = cam 61 | machine = intel 62 | architecture = hybrid 63 | vec_ftns = on 64 | multitask = on 65 | namemod = on 66 | modules = on 67 | End Version Options 68 | 69 | END SIMULATION PARAMETERS 70 | 71 | ENDSIM 72 | -------------------------------------------------------------------------------- /inputs/cam_fixed_aerosols_run6.inp: -------------------------------------------------------------------------------- 1 | BEGSIM 2 | output_unit_number = 7 3 | output_file = cam_fixed_oxidants.doc 4 | procout_path = ../output/ 5 | src_path = ../bkend/ 6 | procfiles_path = ../procfiles/cam/ 7 | sim_dat_path = ../output/ 8 | sim_dat_filename = cam_fixed_oxidants.dat 9 | 10 | Comments 11 | "This is a mozart4 simulation with :" 12 | "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)" 13 | "(2) New aerosol chemistry" 14 | "(3) No groups" 15 | "(4) NCEP inputs (28 levels)" 16 | "(5) no N atom; no NH4, no H2SO4" 17 | End Comments 18 | 19 | SPECIES 20 | 21 | Solution 22 | End Solution 23 | 24 | Fixed 25 | M, N2, O2, H2O, SO4, CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, 26 | SOA -> C12, NH4NO3 27 | SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl 28 | DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5 29 | End Fixed 30 | 31 | Col-int 32 | O3 = 0. 33 | O2 = 0. 34 | End Col-int 35 | 36 | End SPECIES 37 | 38 | Solution Classes 39 | Explicit 40 | End Explicit 41 | Implicit 42 | End Implicit 43 | End Solution Classes 44 | 45 | CHEMISTRY 46 | Photolysis 47 | End Photolysis 48 | 49 | Reactions 50 | End Reactions 51 | 52 | Ext Forcing 53 | End Ext Forcing 54 | 55 | END CHEMISTRY 56 | 57 | SIMULATION PARAMETERS 58 | 59 | Version Options 60 | model = cam 61 | machine = intel 62 | architecture = hybrid 63 | vec_ftns = on 64 | multitask = on 65 | namemod = on 66 | modules = on 67 | End Version Options 68 | 69 | END SIMULATION PARAMETERS 70 | 71 | ENDSIM 72 | -------------------------------------------------------------------------------- /inputs/prog_carbon_sulfate.inp: -------------------------------------------------------------------------------- 1 | BEGSIM 2 | output_unit_number = 7 3 | output_file = cam_fixed_oxidants.doc 4 | procout_path = ../output/ 5 | src_path = ../bkend/ 6 | procfiles_path = ../procfiles/cam/ 7 | sim_dat_path = ../output/ 8 | sim_dat_filename = prog_carbon_sulfate.dat 9 | 10 | Comments 11 | "This is a mozart4 simulation with :" 12 | "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)" 13 | "(2) New aerosol chemistry" 14 | End Comments 15 | 16 | SPECIES 17 | 18 | Solution 19 | H2O2, SO2, SO4, DMS -> CH3SCH3 20 | CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C 21 | End Solution 22 | 23 | Fixed 24 | M, N2, O2, H2O 25 | O3, OH, NO3, HO2 26 | End Fixed 27 | 28 | Col-int 29 | O3 = 0. 30 | O2 = 0. 31 | End Col-int 32 | 33 | End SPECIES 34 | 35 | Solution Classes 36 | Explicit 37 | End Explicit 38 | Implicit 39 | H2O2, SO2, SO4, DMS 40 | CB1, CB2, OC1, OC2 41 | End Implicit 42 | End Solution Classes 43 | 44 | CHEMISTRY 45 | Photolysis 46 | End Photolysis 47 | 48 | Reactions 49 | CB1 -> CB2 ; 1.006e-05 50 | OC1 -> OC2 ; 1.006e-05 51 | End Reactions 52 | 53 | Heterogeneous 54 | H2O2, SO2 55 | End Heterogeneous 56 | 57 | Ext Forcing 58 | SO2 <- dataset 59 | SO4 <- dataset 60 | End Ext Forcing 61 | 62 | END CHEMISTRY 63 | 64 | SIMULATION PARAMETERS 65 | 66 | Version Options 67 | model = cam 68 | machine = intel 69 | architecture = hybrid 70 | vec_ftns = on 71 | multitask = on 72 | namemod = on 73 | modules = on 74 | End Version Options 75 | 76 | END SIMULATION PARAMETERS 77 | 78 | ENDSIM 79 | -------------------------------------------------------------------------------- /inputs/ghg_fixed_aerosols.inp: -------------------------------------------------------------------------------- 1 | BEGSIM 2 | output_unit_number = 7 3 | output_file = ghg_fxd_aero.doc 4 | procout_path = ../output/ 5 | src_path = ../bkend/ 6 | procfiles_path = ../procfiles/cam/ 7 | sim_dat_path = ../output/ 8 | sim_dat_filename = ghg_fxd_aero.dat 9 | 10 | Comments 11 | "This is a mozart4 simulation with :" 12 | "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)" 13 | "(2) New aerosol chemistry" 14 | "(3) No groups" 15 | "(4) NCEP inputs (28 levels)" 16 | "(5) no N atom; no NH4, no H2SO4" 17 | End Comments 18 | 19 | SPECIES 20 | 21 | Solution 22 | CH4, N2O, CFC11 -> CFCl3, CFC12 -> CF2Cl2 23 | End Solution 24 | 25 | Fixed 26 | M, N2, O2, H2O, SO4, CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C 27 | SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl 28 | DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5 29 | O3 30 | End Fixed 31 | 32 | Col-int 33 | O3 = 0. 34 | O2 = 0. 35 | End Col-int 36 | 37 | End SPECIES 38 | 39 | Solution Classes 40 | Explicit 41 | End Explicit 42 | Implicit 43 | CH4, N2O, CFC11, CFC12 44 | End Implicit 45 | End Solution Classes 46 | 47 | CHEMISTRY 48 | Photolysis 49 | End Photolysis 50 | 51 | Reactions 52 | [ch4_loss] CH4 -> 53 | [n2o_loss] N2O -> 54 | [cfc11_loss] CFC11 -> 55 | [cfc12_loss] CFC12 -> 56 | End Reactions 57 | 58 | Heterogeneous 59 | End Heterogeneous 60 | 61 | Ext Forcing 62 | End Ext Forcing 63 | 64 | END CHEMISTRY 65 | 66 | SIMULATION PARAMETERS 67 | 68 | Version Options 69 | model = cam 70 | machine = intel 71 | architecture = hybrid 72 | vec_ftns = on 73 | multitask = on 74 | namemod = on 75 | modules = on 76 | End Version Options 77 | 78 | END SIMULATION PARAMETERS 79 | 80 | ENDSIM 81 | -------------------------------------------------------------------------------- /src/cam_chempp/het_names.f: -------------------------------------------------------------------------------- 1 | 2 | subroutine MAKE_HET_NAME_MOD 3 | !-------------------------------------------------------------------------------- 4 | ! ... Makes a module of parameter reaction names 5 | !-------------------------------------------------------------------------------- 6 | 7 | use RXT_MOD, only : hetcnt, hetmap 8 | use VAR_MOD, only : spc_cnt => new_nq, spc_names => new_solsym 9 | use IO, only : temp_path 10 | 11 | implicit none 12 | 13 | !-------------------------------------------------------------------------------- 14 | ! ... Local variables 15 | !-------------------------------------------------------------------------------- 16 | integer :: i, m 17 | character(len=80) :: buff 18 | character(len=5) :: num 19 | logical :: lexist 20 | 21 | !-------------------------------------------------------------------------------- 22 | ! ... Check mod file existence; remove if found 23 | !-------------------------------------------------------------------------------- 24 | INQUIRE( file = TRIM( temp_path ) // 'het_names.mod', exist = lexist ) 25 | if( lexist ) then 26 | call SYSTEM( 'rm ' // TRIM( temp_path ) // 'het_names.mod' ) 27 | end if 28 | OPEN( unit = 30, file = TRIM( temp_path ) // 'het_names.mod' ) 29 | 30 | buff = '' 31 | write(30,'(a)') buff 32 | buff(7:) = 'module m_het_id' 33 | write(30,'(a)') buff 34 | buff = '' 35 | write(30,'(a)') buff 36 | buff(7:) = 'implicit none' 37 | write(30,'(a)') buff 38 | buff = '' 39 | write(30,'(a)') buff 40 | 41 | do i = 1,hetcnt 42 | m = hetmap(i,1) 43 | write(buff(7:),'(''integer, parameter :: hid_'',a,1x,''='',1x,i4)') & 44 | spc_names(m)(:LEN_TRIM(spc_names(m))), i 45 | write(30,'(a)') buff 46 | end do 47 | 48 | buff = '' 49 | write(30,'(a)') buff 50 | buff(7:) = 'end module m_het_id' 51 | write(30,'(a)') buff 52 | CLOSE(30) 53 | 54 | end subroutine MAKE_HET_NAME_MOD 55 | -------------------------------------------------------------------------------- /inputs/modal_aerosols_3mode_aerocom.in: -------------------------------------------------------------------------------- 1 | SPECIES 2 | 3 | Solution 4 | H2O2, H2SO4, SO2, DMS -> CH3SCH3, SOAG -> C 5 | so4_a1 -> NH4HSO4 6 | pom_a1 -> C, soa_a1 -> C, bc_a1 -> C 7 | dst_a1 -> AlSiO5, ncl_a1 -> NaCl 8 | num_a1 -> H 9 | so4_a2 -> NH4HSO4 10 | soa_a2 -> C, ncl_a2 -> NaCl 11 | num_a2 -> H 12 | dst_a3 -> AlSiO5, ncl_a3 -> NaCl 13 | so4_a3 -> NH4HSO4 14 | num_a3 -> H 15 | End Solution 16 | 17 | Fixed 18 | M, N2, O2, H2O, O3, OH, NO3, HO2 19 | End Fixed 20 | 21 | Col-int 22 | O3 = 0. 23 | O2 = 0. 24 | End Col-int 25 | 26 | End SPECIES 27 | 28 | Solution Classes 29 | Explicit 30 | End Explicit 31 | Implicit 32 | H2O2, H2SO4, SO2, DMS, SOAG 33 | so4_a1, pom_a1 34 | soa_a1, bc_a1, dst_a1, ncl_a1 35 | num_a1 36 | so4_a2, soa_a2, ncl_a2, num_a2 37 | dst_a3, ncl_a3, so4_a3, num_a3 38 | End Implicit 39 | End Solution Classes 40 | 41 | CHEMISTRY 42 | Photolysis 43 | [jh2o2] H2O2 + hv -> 44 | End Photolysis 45 | 46 | Reactions 47 | [usr9] HO2 + HO2 -> H2O2 48 | H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160 49 | [usr23] SO2 + OH -> H2SO4 50 | DMS + OH -> SO2 ; 9.6e-12, -234. 51 | [usr24] DMS + OH -> .5 * SO2 + .5 * HO2 52 | DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520. 53 | End Reactions 54 | 55 | Heterogeneous 56 | H2O2, SO2 57 | End Heterogeneous 58 | 59 | Ext Forcing 60 | SO2 <- dataset 61 | so4_a1 <- dataset 62 | so4_a2 <- dataset 63 | num_a1 <- dataset 64 | num_a2 <- dataset 65 | End Ext Forcing 66 | 67 | END CHEMISTRY 68 | 69 | SIMULATION PARAMETERS 70 | 71 | Version Options 72 | model = cam 73 | machine = intel 74 | architecture = hybrid 75 | vec_ftns = on 76 | multitask = on 77 | namemod = on 78 | modules = on 79 | End Version Options 80 | 81 | END SIMULATION PARAMETERS 82 | -------------------------------------------------------------------------------- /inputs/modal_aerosols_3mode.in: -------------------------------------------------------------------------------- 1 | SPECIES 2 | 3 | Solution 4 | H2O2, H2SO4, SO2, DMS -> CH3SCH3, SOAG -> C 5 | so4_a1 -> NH4HSO4 6 | pom_a1 -> C, soa_a1 -> C, bc_a1 -> C 7 | dst_a1 -> AlSiO5, ncl_a1 -> NaCl 8 | num_a1 -> H 9 | so4_a2 -> NH4HSO4 10 | soa_a2 -> C, ncl_a2 -> NaCl 11 | num_a2 -> H 12 | dst_a3 -> AlSiO5, ncl_a3 -> NaCl 13 | so4_a3 -> NH4HSO4 14 | num_a3 -> H 15 | End Solution 16 | 17 | Fixed 18 | M, N2, O2, H2O, O3, OH, NO3, HO2 19 | End Fixed 20 | 21 | Col-int 22 | O3 = 0. 23 | O2 = 0. 24 | End Col-int 25 | 26 | End SPECIES 27 | 28 | Solution Classes 29 | Explicit 30 | End Explicit 31 | Implicit 32 | H2O2, H2SO4, SO2, DMS, SOAG 33 | so4_a1, pom_a1 34 | soa_a1, bc_a1, dst_a1, ncl_a1 35 | num_a1 36 | so4_a2, soa_a2, ncl_a2, num_a2 37 | dst_a3, ncl_a3, so4_a3, num_a3 38 | End Implicit 39 | End Solution Classes 40 | 41 | CHEMISTRY 42 | Photolysis 43 | [jh2o2] H2O2 + hv -> 44 | End Photolysis 45 | 46 | Reactions 47 | [usr_HO2_HO2] HO2 + HO2 -> H2O2 48 | H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160 49 | [usr_SO2_OH] SO2 + OH -> H2SO4 50 | DMS + OH -> SO2 ; 9.6e-12, -234. 51 | [usr_DMS_OH] DMS + OH -> .5 * SO2 + .5 * HO2 52 | DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520. 53 | End Reactions 54 | 55 | Heterogeneous 56 | H2O2, SO2 57 | End Heterogeneous 58 | 59 | Ext Forcing 60 | SO2 <- dataset 61 | so4_a1 <- dataset 62 | so4_a2 <- dataset 63 | pom_a1 <- dataset 64 | bc_a1 <- dataset 65 | num_a1 <- dataset 66 | num_a2 <- dataset 67 | End Ext Forcing 68 | 69 | END CHEMISTRY 70 | 71 | SIMULATION PARAMETERS 72 | 73 | Version Options 74 | model = cam 75 | machine = intel 76 | architecture = hybrid 77 | vec_ftns = on 78 | multitask = on 79 | namemod = on 80 | modules = on 81 | End Version Options 82 | 83 | END SIMULATION PARAMETERS 84 | -------------------------------------------------------------------------------- /inputs/cam_fixed_oxidants_aerosols.inp: -------------------------------------------------------------------------------- 1 | BEGSIM 2 | output_unit_number = 7 3 | output_file = cam_fixed_oxidants.doc 4 | procout_path = ../output/ 5 | src_path = ../bkend/ 6 | procfiles_path = ../procfiles/cam/ 7 | sim_dat_path = ../output/ 8 | sim_dat_filename = cam_fixed_oxidants.dat 9 | 10 | Comments 11 | "This is a mozart4 simulation with :" 12 | "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)" 13 | "(2) New aerosol chemistry" 14 | "(3) No groups" 15 | "(4) NCEP inputs (28 levels)" 16 | "(5) no N atom; no NH4, no H2SO4" 17 | End Comments 18 | 19 | SPECIES 20 | 21 | Solution 22 | H2O2, SO2, SO4, DMS -> CH3SCH3 23 | CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C 24 | SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl 25 | DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5 26 | End Solution 27 | 28 | Fixed 29 | M, N2, O2, H2O 30 | O3, OH, NO3, HO2 31 | End Fixed 32 | 33 | Col-int 34 | O3 = 0. 35 | O2 = 0. 36 | End Col-int 37 | 38 | End SPECIES 39 | 40 | Solution Classes 41 | Explicit 42 | End Explicit 43 | Implicit 44 | H2O2, SO2, SO4, DMS 45 | CB1, CB2, OC1, OC2 46 | SSLT01, SSLT02, SSLT03, SSLT04 47 | DST01, DST02, DST03, DST04 48 | End Implicit 49 | End Solution Classes 50 | 51 | CHEMISTRY 52 | Photolysis 53 | End Photolysis 54 | 55 | Reactions 56 | CB1 -> CB2 ; 1.006e-05 57 | OC1 -> OC2 ; 1.006e-05 58 | End Reactions 59 | 60 | Heterogeneous 61 | H2O2, SO2 62 | End Heterogeneous 63 | 64 | Ext Forcing 65 | SO2 <- dataset 66 | SO4 <- dataset 67 | End Ext Forcing 68 | 69 | END CHEMISTRY 70 | 71 | SIMULATION PARAMETERS 72 | 73 | Version Options 74 | model = cam 75 | machine = intel 76 | architecture = hybrid 77 | vec_ftns = on 78 | multitask = on 79 | namemod = on 80 | modules = on 81 | End Version Options 82 | 83 | END SIMULATION PARAMETERS 84 | 85 | ENDSIM 86 | -------------------------------------------------------------------------------- /src/cam_chempp/res_hdr.f: -------------------------------------------------------------------------------- 1 | 2 | subroutine RES_HDR( plon, & 3 | plonl, & 4 | plat, & 5 | plev, & 6 | jintmx, & 7 | nxpt, & 8 | arch_type, & 9 | cpucnt ) 10 | 11 | implicit none 12 | 13 | !----------------------------------------------------------------------- 14 | ! ... The arguments 15 | !----------------------------------------------------------------------- 16 | integer, intent(in) :: plon 17 | integer, intent(in) :: plonl 18 | integer, intent(in) :: plat 19 | integer, intent(in) :: plev 20 | integer, intent(in) :: jintmx 21 | integer, intent(in) :: nxpt 22 | integer, intent(in) :: cpucnt 23 | character(len=16), intent(in) :: arch_type 24 | 25 | !----------------------------------------------------------------------- 26 | ! ... The local variables 27 | !----------------------------------------------------------------------- 28 | character(len=72) :: comment 29 | logical :: lexist 30 | 31 | INQUIRE( file = 'res.h', exist = lexist ) 32 | if( lexist ) then 33 | call SYSTEM( 'rm res.h' ) 34 | end if 35 | OPEN( unit = 30, file = 'res.h' ) 36 | 37 | write(30,'(''# define PLON '',i3)') plon 38 | write(30,'(''# define PLONP2 '',i3)') plon + 2 39 | if( arch_type == 'HYBRID' ) then 40 | write(30,'(''# define PLONL '',i3)') plonl 41 | end if 42 | write(30,'(''# define NXPT '',i3)') nxpt 43 | write(30,'(''# define JINTMX '',i3)') jintmx 44 | write(30,'(''# define NXPTJ '',i3)') nxpt + jintmx 45 | write(30,'(''# define PLOND '',i3)') plon + 1 + 2*nxpt 46 | write(30,'(''# define PLAT '',i3)') plat 47 | write(30,'(''# define PLEV '',i3)') plev 48 | write(30,'(''# define PLEVP '',i3)') plev + 1 49 | write(30,'(''# define PLEVM '',i3)') plev - 1 50 | write(30,'(''# define PLNPLV '',i6)') plon*plev 51 | write(30,'(''# define I1 '',i3)') 1 + nxpt 52 | write(30,'(''# define I1M '',i3)') nxpt 53 | write(30,'(''# define J1 '',i3)') 1 + nxpt + jintmx 54 | write(30,'(''# define J1M '',i3)') nxpt + jintmx 55 | write(30,'(''# define PTIML 2 '')') 56 | 57 | CLOSE(30) 58 | 59 | end subroutine RES_HDR 60 | -------------------------------------------------------------------------------- /src/cam_chempp/params_hdr.f: -------------------------------------------------------------------------------- 1 | 2 | subroutine PARAMS_HDR( plon, plonl, plat, plev, & 3 | phtcnt, rxntot, & 4 | adv_cnt, nadv_cnt, histout_cnt, & 5 | chemistry, diffusion, convection, arch_type, & 6 | filespec ) 7 | !----------------------------------------------------------------------- 8 | ! ... Make the params.h file 9 | !----------------------------------------------------------------------- 10 | 11 | use IO, only : lout 12 | 13 | implicit none 14 | 15 | !----------------------------------------------------------------------- 16 | ! ... Dummy args 17 | !----------------------------------------------------------------------- 18 | integer, intent(in) :: plon, plonl, plat, plev 19 | integer, intent(in) :: phtcnt, rxntot 20 | integer, intent(in) :: adv_cnt, nadv_cnt 21 | integer, intent(in) :: histout_cnt(20,2) 22 | logical, intent(in) :: chemistry, diffusion, convection 23 | character(len=16), intent(in) :: arch_type 24 | character(len=*), intent(in) :: filespec 25 | 26 | !----------------------------------------------------------------------- 27 | ! ... The local variables 28 | !----------------------------------------------------------------------- 29 | integer :: ios 30 | logical :: lexist 31 | 32 | INQUIRE( file = TRIM(filespec), exist = lexist ) 33 | if( lexist ) then 34 | call SYSTEM( 'rm '//TRIM(filespec) ) 35 | end if 36 | OPEN( unit = 30, file = TRIM(filespec), iostat=ios ) 37 | if( ios /= 0 ) then 38 | write(lout,*) 'PARAMS_HDR: Failed to open simulation datafile ',TRIM(filespec),' ;error = ',ios 39 | stop 40 | end if 41 | write(30,'(a)') '# ifndef PARAMS_H' 42 | write(30,'(a)') '# define PARAMS_H' 43 | write(30,'('' '')') 44 | write(30,'(a)') '# define CALC_ETADOT' 45 | if( diffusion ) then 46 | write(30,'(a)') '# define DI_VDIFF' 47 | else 48 | write(30,'(a)') '# define AR_VDIFF' 49 | end if 50 | if( convection ) then 51 | write(30,'(a)') '# define DI_CONV_CCM' 52 | else 53 | write(30,'(a)') '# define AR_CONV_CCM' 54 | end if 55 | write(30,'(a)') '# define DI_CLOUD_PHYS' 56 | if( chemistry ) then 57 | write(30,'(a)') '# define TROP_CHEM' 58 | end if 59 | write(30,'('' '')') 60 | write(30,'(a)') '# endif' 61 | 62 | end subroutine PARAMS_HDR 63 | -------------------------------------------------------------------------------- /src/cam_chempp/tokens.f: -------------------------------------------------------------------------------- 1 | subroutine GETTOKENS( string, & 2 | ls, & 3 | delim, & 4 | maxlen, & 5 | tokens, & 6 | toklen, & 7 | maxtok, & 8 | tokcnt ) 9 | 10 | implicit none 11 | 12 | !----------------------------------------------------------------------- 13 | ! Input arguments: 14 | ! string - character string to crack into tokens 15 | ! ls - length of string 16 | ! delim - token delimiter character 17 | ! maxlen - maximum length of any single token 18 | ! maxtok - maximum number of tokens 19 | ! Output arguments: 20 | ! tokcnt - number of actual tokens 21 | ! < 0 => hit maxtok before end of string 22 | ! = 0 => error in input string 23 | ! toklen - array containing length of each token 24 | ! tokens - character array of tokens 25 | !----------------------------------------------------------------------- 26 | 27 | integer, intent(in) :: ls, maxlen, maxtok 28 | integer, intent(out) :: tokcnt 29 | integer, intent(out) :: toklen(*) 30 | 31 | character(len=*), intent(in) :: string 32 | character(len=*), intent(out) :: tokens(*) 33 | character(len=1), intent(in) :: delim 34 | 35 | !----------------------------------------------------------------------- 36 | ! ... Local variables 37 | !----------------------------------------------------------------------- 38 | integer :: marker, i, length, endpos 39 | 40 | tokcnt = 0 41 | marker = 1 42 | do i = 1,ls 43 | if( string(i:i) == delim .or. i == ls ) then 44 | if( i == ls ) then 45 | if( string(i:i) == delim ) then 46 | tokcnt = 0 47 | exit 48 | end if 49 | length = i - marker + 1 50 | endpos = i 51 | else 52 | length = i - marker 53 | endpos = i - 1 54 | end if 55 | if( length < 1 .or. length > maxlen ) then 56 | tokcnt = 0 57 | exit 58 | end if 59 | tokcnt = tokcnt + 1 60 | if( tokcnt > maxtok ) then 61 | tokcnt = -tokcnt 62 | exit 63 | end if 64 | tokens(tokcnt) = ' ' 65 | tokens(tokcnt)(:length) = string(marker:endpos) 66 | toklen(tokcnt) = length 67 | marker = i + 1 68 | end if 69 | end do 70 | 71 | end subroutine GETTOKENS 72 | -------------------------------------------------------------------------------- /inputs/modal_aerosols_7mode.in: -------------------------------------------------------------------------------- 1 | SPECIES 2 | 3 | Solution 4 | H2O2, H2SO4, SO2, DMS -> CH3SCH3, NH3, 5 | SOAG -> C 6 | so4_a1 -> SO4, 7 | nh4_a1 -> NH4 8 | pom_a1 -> C, 9 | soa_a1 -> C, 10 | bc_a1 -> C, 11 | ncl_a1 -> NaCl 12 | num_a1 -> H 13 | so4_a2 -> SO4, 14 | nh4_a2 -> NH4 15 | soa_a2 -> C, 16 | ncl_a2 -> NaCl 17 | num_a2 -> H 18 | pom_a3 -> C, 19 | bc_a3 -> C 20 | num_a3 -> H 21 | ncl_a4 -> NaCl, 22 | so4_a4 -> SO4 23 | nh4_a4 -> NH4, 24 | num_a4 -> H 25 | dst_a5 -> AlSiO5, 26 | so4_a5 -> SO4 27 | nh4_a5 -> NH4, 28 | num_a5 -> H 29 | ncl_a6 -> NaCl, 30 | so4_a6 -> SO4 31 | nh4_a6 -> NH4, 32 | num_a6 -> H 33 | dst_a7 -> AlSiO5, 34 | so4_a7 -> SO4 35 | nh4_a7 -> NH4, 36 | num_a7 -> H 37 | End Solution 38 | 39 | Fixed 40 | M, N2, O2, H2O, O3, OH, NO3, HO2 41 | End Fixed 42 | 43 | Col-int 44 | O3 = 0. 45 | O2 = 0. 46 | End Col-int 47 | 48 | End SPECIES 49 | 50 | Solution Classes 51 | Explicit 52 | End Explicit 53 | Implicit 54 | H2O2, H2SO4, SO2, DMS, NH3, SOAG 55 | so4_a1, nh4_a1, pom_a1 56 | soa_a1, bc_a1, ncl_a1, num_a1 57 | so4_a2, nh4_a2, soa_a2, ncl_a2 58 | num_a2 59 | pom_a3, bc_a3, num_a3 60 | ncl_a4, so4_a4, nh4_a4, num_a4 61 | dst_a5, so4_a5, nh4_a5, num_a5 62 | ncl_a6, so4_a6, nh4_a6, num_a6 63 | dst_a7, so4_a7, nh4_a7, num_a7 64 | End Implicit 65 | End Solution Classes 66 | 67 | CHEMISTRY 68 | Photolysis 69 | [jh2o2] H2O2 + hv -> 70 | End Photolysis 71 | 72 | Reactions 73 | [usr_HO2_HO2] HO2 + HO2 -> H2O2 74 | H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160 75 | [usr_SO2_OH] SO2 + OH -> H2SO4 76 | DMS + OH -> SO2 ; 9.6e-12, -234. 77 | [usr_DMS_OH] DMS + OH -> .5 * SO2 + .5 * HO2 78 | DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520. 79 | NH3 + OH -> H2O ; 1.7e-12, -710. 80 | End Reactions 81 | 82 | Heterogeneous 83 | H2O2, SO2 84 | End Heterogeneous 85 | 86 | Ext Forcing 87 | SO2 <- dataset 88 | so4_a1 <- dataset 89 | so4_a2 <- dataset 90 | num_a1 <- dataset 91 | num_a2 <- dataset 92 | End Ext Forcing 93 | 94 | END CHEMISTRY 95 | 96 | SIMULATION PARAMETERS 97 | 98 | Version Options 99 | model = cam 100 | machine = intel 101 | architecture = hybrid 102 | vec_ftns = on 103 | multitask = on 104 | namemod = on 105 | modules = on 106 | End Version Options 107 | 108 | END SIMULATION PARAMETERS 109 | -------------------------------------------------------------------------------- /src/cam_chempp/rxt_names.f: -------------------------------------------------------------------------------- 1 | 2 | subroutine make_rxt_name_mod 3 | !-------------------------------------------------------------------------------- 4 | ! ... Makes a module of parameter reaction names 5 | !-------------------------------------------------------------------------------- 6 | 7 | use rxt_mod, only : rxtcnt => rxntot, gascnt, phtcnt, rxt_tag, rxt_has_tag 8 | use io, only : temp_path 9 | 10 | implicit none 11 | 12 | !-------------------------------------------------------------------------------- 13 | ! ... Local variables 14 | !-------------------------------------------------------------------------------- 15 | integer :: i 16 | character(len=80) :: buff 17 | character(len=5) :: num 18 | logical :: lexist 19 | 20 | !-------------------------------------------------------------------------------- 21 | ! ... Check mod file existence; remove if found 22 | !-------------------------------------------------------------------------------- 23 | inquire( file = trim( temp_path ) // 'rxt_names.mod', exist = lexist ) 24 | if( lexist ) then 25 | call system( 'rm ' // trim( temp_path ) // 'rxt_names.mod' ) 26 | end if 27 | open( unit = 30, file = trim( temp_path ) // 'rxt_names.mod' ) 28 | 29 | buff = '' 30 | write(30,'(a)') buff 31 | buff(7:) = 'module m_rxt_id' 32 | write(30,'(a)') buff 33 | buff = '' 34 | write(30,'(a)') buff 35 | buff(7:) = 'implicit none' 36 | write(30,'(a)') buff 37 | buff = '' 38 | write(30,'(a)') buff 39 | 40 | do i = 1,rxtcnt 41 | if( rxt_tag(i) /= ' ' ) then 42 | rxt_has_tag(i) = .true. 43 | write(buff(7:),'(''integer, parameter :: rid_'',a,1x,''='',1x,i4)') & 44 | rxt_tag(i)(:len_trim(rxt_tag(i))), i 45 | write(30,'(a)') buff 46 | end if 47 | end do 48 | 49 | if( any( rxt_has_tag(:rxtcnt) ) ) then 50 | buff = '' 51 | write(30,'(a)') buff 52 | end if 53 | 54 | do i = 1,rxtcnt 55 | if( .not. rxt_has_tag(i) ) then 56 | write(num,'(i5)') i+10000 57 | if( i <= phtcnt ) then 58 | write(buff(7:),'(''integer, parameter :: rid_j'',a,1x,''='',1x,i4)') & 59 | num(2:5), i 60 | write(rxt_tag(i)(:5),'(''j'',a)') num(2:5) 61 | else 62 | write(buff(7:),'(''integer, parameter :: rid_r'',a,1x,''='',1x,i4)') & 63 | num(2:5), i 64 | write(rxt_tag(i)(:5),'(''r'',a)') num(2:5) 65 | end if 66 | write(30,'(a)') buff 67 | end if 68 | end do 69 | 70 | buff = '' 71 | write(30,'(a)') buff 72 | buff(7:) = 'end module m_rxt_id' 73 | write(30,'(a)') buff 74 | close( 30 ) 75 | 76 | end subroutine make_rxt_name_mod 77 | -------------------------------------------------------------------------------- /inputs/cam_fixed_oxidants_modal_aero_cw_3modes_0707.inp: -------------------------------------------------------------------------------- 1 | BEGSIM 2 | output_unit_number = 7 3 | output_file = cam_fixed_oxidants_modal_aero_cw_3modes_0707.doc 4 | procout_path = ../output/ 5 | src_path = ../bkend/ 6 | procfiles_path = ../procfiles/cam/ 7 | sim_dat_path = ../output/ 8 | sim_dat_filename = cam_fixed_oxidants_modal_aero_cw_3modes_0707.dat 9 | 10 | Comments 11 | "This is a mozart4 simulation with :" 12 | "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)" 13 | "(2) New aerosol chemistry" 14 | "(3) No groups" 15 | "(4) NCEP inputs (28 levels)" 16 | "(5) no N atom; no NH4, no H2SO4" 17 | End Comments 18 | 19 | SPECIES 20 | 21 | Solution 22 | H2O2, H2SO4, SO2, DMS -> CH3SCH3, SOAG -> C 23 | so4_a1 -> NH4HSO4 24 | pom_a1 -> C, soa_a1 -> C, bc_a1 -> C 25 | dst_a1 -> AlSiO5, ncl_a1 -> NaCl 26 | num_a1 -> H 27 | so4_a2 -> NH4HSO4 28 | soa_a2 -> C, ncl_a2 -> NaCl 29 | num_a2 -> H 30 | dst_a3 -> AlSiO5, ncl_a3 -> NaCl 31 | so4_a3 -> NH4HSO4 32 | num_a3 -> H 33 | End Solution 34 | 35 | Fixed 36 | M, N2, O2, H2O, O3, OH, NO3, HO2 37 | End Fixed 38 | 39 | Col-int 40 | O3 = 0. 41 | O2 = 0. 42 | End Col-int 43 | 44 | End SPECIES 45 | 46 | Solution Classes 47 | Explicit 48 | End Explicit 49 | Implicit 50 | H2O2, H2SO4, SO2, DMS, SOAG 51 | so4_a1, pom_a1 52 | soa_a1, bc_a1, dst_a1, ncl_a1 53 | num_a1 54 | so4_a2, soa_a2, ncl_a2, num_a2 55 | dst_a3, ncl_a3, so4_a3, num_a3 56 | End Implicit 57 | End Solution Classes 58 | 59 | CHEMISTRY 60 | Photolysis 61 | [jh2o2] H2O2 + hv -> 62 | End Photolysis 63 | 64 | Reactions 65 | [usr9] HO2 + HO2 -> H2O2 66 | H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160 67 | [usr23] SO2 + OH -> H2SO4 68 | DMS + OH -> SO2 ; 9.6e-12, -234. 69 | [usr24] DMS + OH -> .5 * SO2 + .5 * HO2 70 | DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520. 71 | End Reactions 72 | 73 | Heterogeneous 74 | H2O2, SO2 75 | End Heterogeneous 76 | 77 | Ext Forcing 78 | SO2 <- dataset 79 | so4_a1 <- dataset 80 | so4_a2 <- dataset 81 | num_a1 <- dataset 82 | num_a2 <- dataset 83 | End Ext Forcing 84 | 85 | END CHEMISTRY 86 | 87 | SIMULATION PARAMETERS 88 | 89 | Version Options 90 | model = cam 91 | machine = intel 92 | architecture = hybrid 93 | vec_ftns = on 94 | multitask = on 95 | namemod = on 96 | modules = on 97 | End Version Options 98 | 99 | END SIMULATION PARAMETERS 100 | 101 | ENDSIM 102 | -------------------------------------------------------------------------------- /src/cam_chempp/make_names.f: -------------------------------------------------------------------------------- 1 | 2 | subroutine make_name_mod 3 | !-------------------------------------------------------------------------------- 4 | ! ... Makes a module of parameter species names 5 | !-------------------------------------------------------------------------------- 6 | 7 | use var_mod, only : spc_cnt => new_nq, spc_names => new_solsym, & 8 | grp_mem_cnt, grp_mem_names => grp_mem_sym 9 | use io, only : temp_path 10 | 11 | implicit none 12 | 13 | !-------------------------------------------------------------------------------- 14 | ! ... Local variables 15 | !-------------------------------------------------------------------------------- 16 | integer :: i, j 17 | integer :: beg, end 18 | character(len=80) :: buff 19 | character(len=63) :: legal = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' & 20 | // 'abcdefghijklmnopqrstuvwxyz' & 21 | // '0123456789_' 22 | character(len=16) :: name 23 | logical :: lexist 24 | 25 | inquire( file = trim( temp_path ) // 'spc_names.mod', exist = lexist ) 26 | if( lexist ) then 27 | call system( 'rm ' // trim( temp_path ) // 'spc_names.mod' ) 28 | end if 29 | open( unit = 30, & 30 | file = trim( temp_path ) // 'spc_names.mod' ) 31 | 32 | buff = ' ' 33 | write(30,*) ' ' 34 | buff(7:) = 'module m_spc_id' 35 | write(30,'(a)') buff 36 | write(30,*) ' ' 37 | buff(7:) = 'implicit none' 38 | write(30,'(a)') buff 39 | buff = ' ' 40 | write(30,*) ' ' 41 | 42 | do i = 1,spc_cnt 43 | name = spc_names(i) 44 | end = len_trim(name) 45 | beg = 1 46 | do 47 | j = VERIFY( name(beg:end), legal ) 48 | if( j == 0 ) then 49 | exit 50 | end if 51 | j = j + beg - 1 52 | if( j == end ) then 53 | end = end - 1 54 | exit 55 | end if 56 | name(j:j) = '_' 57 | if( j >= end ) then 58 | exit 59 | end if 60 | beg = j + 1 61 | end do 62 | write(buff(7:),'(''integer, parameter :: id_'',a,1x,''='',1x,i3)') & 63 | name(:end), i 64 | write(30,'(a)') buff(:len_trim(buff)) 65 | end do 66 | write(30,*) ' ' 67 | do i = 1,grp_mem_cnt 68 | name = grp_mem_names(i) 69 | end = len_trim(name) 70 | beg = 1 71 | do 72 | j = VERIFY( name(beg:end), legal ) 73 | if( j == 0 ) then 74 | exit 75 | end if 76 | j = j + beg - 1 77 | if( j == end ) then 78 | end = end - 1 79 | exit 80 | end if 81 | name(j:j) = '_' 82 | if( j >= end ) then 83 | exit 84 | end if 85 | beg = j + 1 86 | end do 87 | write(buff(7:),'(''integer, parameter :: id_'',a,1x,''='',1x,i3)') & 88 | name(:end), i 89 | write(30,'(a)') buff(:len_trim(buff)) 90 | end do 91 | buff = ' ' 92 | write(30,*) ' ' 93 | buff(7:) = 'end module m_spc_id' 94 | write(30,'(a)') buff 95 | CLOSE(30) 96 | 97 | end subroutine MAKE_NAME_MOD 98 | -------------------------------------------------------------------------------- /inputs/cam_TP1.inp: -------------------------------------------------------------------------------- 1 | BEGSIM 2 | output_unit_number = 7 3 | output_file = cam_aer_nosynoz.doc 4 | procout_path = ../output/ 5 | src_path = ../bkend/ 6 | procfiles_path = ../procfiles/cam/ 7 | sim_dat_path = ../output/ 8 | sim_dat_filename = cam_aer_nosynoz.dat 9 | 10 | Comments 11 | "This is a mozart4 simulation with :" 12 | "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)" 13 | "(2) New aerosol chemistry" 14 | "(3) No groups" 15 | "(4) NCEP inputs (28 levels)" 16 | "(5) no N atom; no NH4, no H2SO4" 17 | End Comments 18 | 19 | SPECIES 20 | 21 | Solution 22 | CO 23 | COEA -> CO 24 | COSA -> CO 25 | COEU -> CO 26 | CONA -> CO 27 | COAVOC -> CO 28 | COBVOC -> CO 29 | COCH4 -> CO 30 | CAVOC -> C 31 | CBVOC -> C 32 | PRO1 -> C3H8 33 | BUT1 -> C4H10 34 | ETH1 -> C2H6 35 | PRO2 -> C3H8 36 | BUT2 -> C4H10 37 | ETH2 -> C2H6 38 | End Solution 39 | 40 | Fixed 41 | M, N2, O2, H2O, CH4 42 | End Fixed 43 | 44 | Col-int 45 | End Col-int 46 | 47 | End SPECIES 48 | 49 | Solution Classes 50 | Explicit 51 | CO 52 | COEA 53 | COSA 54 | COEU 55 | CONA 56 | COAVOC 57 | COBVOC 58 | COCH4 59 | CAVOC 60 | CBVOC 61 | PRO1 62 | BUT1 63 | ETH1 64 | PRO2 65 | BUT2 66 | ETH2 67 | End Explicit 68 | Implicit 69 | End Implicit 70 | End Solution Classes 71 | 72 | CHEMISTRY 73 | Photolysis 74 | End Photolysis 75 | 76 | Reactions 77 | CO -> ; 4.62963e-07 78 | COEA -> ; 4.62963e-07 79 | COSA -> ; 4.62963e-07 80 | COEU -> ; 4.62963e-07 81 | CONA -> ; 4.62963e-07 82 | COAVOC -> ; 4.62963e-07 83 | COBVOC -> ; 4.62963e-07 84 | COCH4 -> ; 4.62963e-07 85 | CAVOC -> 0.7*COAVOC ; 1.65344e-06 86 | CBVOC -> 0.4*COBVOC ; 1.15741e-05 87 | CH4 -> 0.86*COCH4 ; 3.83142e-07 88 | PRO1 -> ; 0.86e-7 89 | BUT1 -> ; 2.05e-7 90 | ETH1 -> ; 0.18e-7 91 | PRO2 -> ; 1.72e-7 92 | BUT2 -> ; 4.10e-7 93 | ETH2 -> ; 0.36e-7 94 | End Reactions 95 | 96 | Heterogeneous 97 | End Heterogeneous 98 | 99 | Ext Forcing 100 | End Ext Forcing 101 | 102 | END CHEMISTRY 103 | 104 | SIMULATION PARAMETERS 105 | 106 | Version Options 107 | model = cam 108 | machine = intel 109 | architecture = hybrid 110 | vec_ftns = on 111 | multitask = on 112 | namemod = on 113 | modules = on 114 | End Version Options 115 | 116 | END SIMULATION PARAMETERS 117 | 118 | ENDSIM 119 | -------------------------------------------------------------------------------- /src/cam_chempp/sub_scan.f: -------------------------------------------------------------------------------- 1 | 2 | subroutine SUB_SCAN( filecnt, & 3 | lib_files, & 4 | usr_paths, & 5 | usr_files, & 6 | sub_cnt ) 7 | !--------------------------------------------------------------------- 8 | ! ... This subroutine scans a "standard" library routine for 9 | ! matching user routines which will override the library 10 | ! routine. 11 | !--------------------------------------------------------------------- 12 | 13 | implicit none 14 | 15 | !--------------------------------------------------------------------- 16 | ! ... Dummy args 17 | !--------------------------------------------------------------------- 18 | integer, intent(in) :: filecnt ! count of library subroutines 19 | integer, intent(inout) :: sub_cnt ! count of "user" subroutines 20 | character(len=*), intent(inout) :: lib_files(*) ! library filenames 21 | character(len=*), intent(inout) :: usr_files(*) ! user filenames 22 | character(len=*), intent(inout) :: usr_paths(*) ! user filepaths 23 | 24 | !--------------------------------------------------------------------- 25 | ! ... Local variables 26 | !--------------------------------------------------------------------- 27 | integer :: i, j, alls, cnt 28 | integer, allocatable :: mark(:) 29 | character(len=128), allocatable :: wrk_files(:) ! work space 30 | character(len=128), allocatable :: wrk_paths(:) ! work space 31 | logical, allocatable :: keep(:) 32 | 33 | if( filecnt > 0 .and. sub_cnt > 0 ) then 34 | ALLOCATE( wrk_files(sub_cnt), wrk_paths(sub_cnt), keep(sub_cnt), stat = alls ) 35 | if( alls /= 0 ) then 36 | write(*,*) ' SUB_SCAN : Failed to allocated wrk array' 37 | stop 'Alloc err' 38 | end if 39 | ALLOCATE( mark(filecnt), stat = alls ) 40 | if( alls /= 0 ) then 41 | write(*,*) ' SUB_SCAN : Failed to allocated wrk array' 42 | stop 'Alloc err' 43 | end if 44 | wrk_files(:sub_cnt) = usr_files(:sub_cnt) 45 | wrk_paths(:sub_cnt) = usr_paths(:sub_cnt) 46 | do i = 1,filecnt 47 | mark(i) = INDEX( lib_files(i)(:LEN_TRIM(lib_files(i))), & 48 | '/', back = .true. ) + 1 49 | end do 50 | keep(:sub_cnt) = .true. 51 | do i = 1,filecnt 52 | do j = 1,sub_cnt 53 | if( keep(j) .and. & 54 | lib_files(i)(mark(i):LEN_TRIM(lib_files(i))) == & 55 | wrk_files(j)(:LEN_TRIM(wrk_files(j))) ) then 56 | lib_files(i) = wrk_paths(j)(:LEN_TRIM(usr_paths(j))) & 57 | // wrk_files(j)(:LEN_TRIM(wrk_files(j))) 58 | keep(j) = .false. 59 | exit 60 | end if 61 | end do 62 | end do 63 | 64 | cnt = COUNT( keep(:sub_cnt) ) 65 | if( cnt /= sub_cnt ) then 66 | usr_files(:cnt) = PACK( wrk_files(:sub_cnt), mask = keep(:sub_cnt) ) 67 | usr_paths(:cnt) = PACK( wrk_paths(:sub_cnt), mask = keep(:sub_cnt) ) 68 | sub_cnt = cnt 69 | end if 70 | DEALLOCATE( wrk_files ) 71 | DEALLOCATE( wrk_paths ) 72 | DEALLOCATE( keep ) 73 | DEALLOCATE( mark ) 74 | end if 75 | 76 | end subroutine SUB_SCAN 77 | -------------------------------------------------------------------------------- /src/cam_chempp/exe_opts.f: -------------------------------------------------------------------------------- 1 | subroutine EXE_OPTS( options, & 2 | lin, & 3 | lout ) 4 | !----------------------------------------------------------------------- 5 | ! ... Set the execution options 6 | !----------------------------------------------------------------------- 7 | 8 | implicit none 9 | 10 | !----------------------------------------------------------------------- 11 | ! ... Dummy args 12 | !----------------------------------------------------------------------- 13 | integer, intent(in) :: lin 14 | integer, intent(in) :: lout 15 | logical, intent(out) :: options(3) 16 | 17 | !----------------------------------------------------------------------- 18 | ! ... Local variables 19 | !----------------------------------------------------------------------- 20 | integer :: kpar, nchar, k 21 | integer :: parsw(3) 22 | 23 | character(len=80) :: buff 24 | character(len=20) :: parkey(3), keywrd 25 | logical :: found 26 | 27 | integer :: LENOF 28 | 29 | parkey(1) = 'QSUBFILE' 30 | parkey(2) = 'SUBMIT' 31 | parkey(3) = 'FIXER' 32 | 33 | parsw = 0 34 | 35 | !----------------------------------------------------------------------- 36 | ! ... Scan for valid option keyword 37 | !----------------------------------------------------------------------- 38 | do 39 | call CARDIN( lin, buff, nchar ) 40 | call UPCASE ( buff ) 41 | if( buff == 'ENDEXECUTIONOPTIONS' ) then 42 | exit 43 | end if 44 | k = INDEX( buff(:nchar), '=' ) 45 | if( k /= 0 ) then 46 | keywrd = buff(:k-1) 47 | found = .false. 48 | do kpar = 1,6 49 | if( keywrd == parkey(kpar) ) then 50 | found = .true. 51 | exit 52 | end if 53 | end do 54 | if( .not. found ) then 55 | call ERRMES ( ' # is an invalid options' & 56 | // ' parameter keyword@', lout, keywrd, & 57 | LENOF(20,keywrd), buff ) 58 | end if 59 | else 60 | !----------------------------------------------------------------------- 61 | ! ... Invalid parameter keyword; terminate the program 62 | !----------------------------------------------------------------------- 63 | call ERRMES( ' option specification has no = operator@', & 64 | lout, buff, 1, buff ) 65 | end if 66 | 67 | !----------------------------------------------------------------------- 68 | ! ... Valid parameter keyword; now check for duplicate keyword 69 | !----------------------------------------------------------------------- 70 | if( parsw(kpar) /= 0 ) then 71 | call ERRMES( '0 *** # has already been specified@', & 72 | lout, parkey(kpar), k, ' ' ) 73 | end if 74 | 75 | !----------------------------------------------------------------------- 76 | ! ... Set individual options 77 | !----------------------------------------------------------------------- 78 | if( buff(k+1:nchar) == 'ON' .or. & 79 | buff(k+1:nchar) == 'YES' ) then 80 | options(kpar) = .true. 81 | else 82 | options(kpar) = .false. 83 | end if 84 | parsw(kpar) = 1 85 | end do 86 | 87 | end subroutine EXE_OPTS 88 | -------------------------------------------------------------------------------- /inputs/super_fast_LLNL.tuv.in: -------------------------------------------------------------------------------- 1 | SPECIES 2 | 3 | Solution 4 | O3, OH -> HO, HO2, H2O2, NO, NO2, HNO3, CO, CH4, CH2O, CH3O2 5 | CH3OOH -> CH4O2, DMS -> C2H6S, SO2 -> O2S, 6 | SO4 7 | End Solution 8 | 9 | Fixed 10 | M, N2, O2, H2O 11 | End Fixed 12 | 13 | Col-int 14 | O3 = 0. 15 | O2 = 0. 16 | End Col-int 17 | 18 | END Species 19 | 20 | Solution classes 21 | Explicit 22 | CO, CH4 23 | End explicit 24 | Implicit 25 | O3, OH, HO2, H2O2, NO, NO2, HNO3, CH2O, CH3O2, CH3OOH 26 | DMS, SO2, SO4 27 | End implicit 28 | END Solution classes 29 | 30 | CHEMISTRY 31 | Photolysis 32 | [jo1d] O3 + hv -> 2*OH 33 | [jh2o2] H2O2 + hv -> 2*OH 34 | [jno2] NO2 + hv -> NO + O3 35 | [jch2o_a] CH2O + hv -> CO + 2*HO2 36 | [jch2o_b] CH2O + hv -> CO 37 | [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH 38 | End Photolysis 39 | 40 | Reactions 41 | O3 + OH -> HO2 + O2 ; 1.700E-12, -940 42 | [out6] HO2 + O3 -> 2*O2 + OH ; 1.000E-14, -490 43 | HO2 + OH -> H2O + O2 ; 4.800E-11, 250 44 | [usr_HO2_HO2] HO2 + HO2 -> H2O2 + O2 45 | H2O2 + OH -> H2O + HO2 ; 1.800E-12 46 | NO + O3 -> NO2 + O2 ; 3.000E-12, -1500 47 | HO2 + NO -> NO2 + OH ; 3.500E-12, 250 48 | NO2 + OH + M -> HNO3 ; 1.800E-30, 3.00, 2.800E-11, 0.00, 0.6 49 | CH4 + OH -> CH3O2 + H2O ; 2.450E-12, -1775 50 | [usr_oh_co] CO + OH -> HO2 51 | CH2O + OH -> CO + H2O + HO2 ; 5.500E-12, 125 52 | CH3O2 + HO2 -> CH3OOH + O2 ; 4.100E-13, 750 53 | CH3OOH + OH -> CH3O2 + H2O ; 2.700E-12, 200 54 | CH3OOH + OH -> CH2O + H2O + OH ; 1.100E-12, 200 55 | CH3O2 + NO -> CH2O + HO2 + NO2 ; 2.800E-12, 300 56 | CH3O2 + CH3O2 -> 2*CH2O + 0.80*HO2 ; 9.500E-14, 390 57 | [het_no2_h2o] H2O + NO2 -> 0.50*HNO3 58 | DMS + OH -> SO2 ; 1.100E-11, -240 59 | [usr_oh_dms] DMS + OH -> 0.75*SO2 60 | [tag_so2_oh_m] OH + SO2 + M -> SO4 ; 3.300E-31, 4.30, 1.600E-12, 0.00, 0.6 61 | [aq_so2_h2o2] H2O2 + SO2 -> SO4 62 | [aq_so2_o3] O3 + SO2 -> SO4 63 | End reactions 64 | 65 | Heterogeneous 66 | H2O2, HNO3, CH2O, SO2 67 | End heterogeneous 68 | 69 | Ext forcing 70 | NO2, CO 71 | End Ext Forcing 72 | 73 | END Chemistry 74 | 75 | SIMULATION PARAMETERS 76 | 77 | Version Options 78 | model = cam 79 | machine = intel 80 | architecture = hybrid 81 | vec_ftns = on 82 | multitask = on 83 | namemod = on 84 | modules = on 85 | End Version Options 86 | 87 | End Simulation Parameters 88 | -------------------------------------------------------------------------------- /inputs/super_fast_LLNL.lut.in: -------------------------------------------------------------------------------- 1 | SPECIES 2 | 3 | Solution 4 | O3, OH -> HO, HO2, H2O2, NO, NO2, HNO3, CO, CH4, CH2O, CH3O2 5 | CH3OOH -> CH4O2, DMS -> C2H6S, SO2 -> O2S, 6 | SO4 7 | End Solution 8 | 9 | Fixed 10 | M, N2, O2, H2O 11 | End Fixed 12 | 13 | Col-int 14 | O3 = 0. 15 | O2 = 0. 16 | End Col-int 17 | 18 | END Species 19 | 20 | Solution classes 21 | Explicit 22 | CO, CH4 23 | End explicit 24 | Implicit 25 | O3, OH, HO2, H2O2, NO, NO2, HNO3, CH2O, CH3O2, CH3OOH 26 | DMS, SO2, SO4 27 | End implicit 28 | END Solution classes 29 | 30 | CHEMISTRY 31 | Photolysis 32 | [jo1d->,jo3_a] O3 + hv -> 2*OH 33 | [jh2o2] H2O2 + hv -> 2*OH 34 | [jno2] NO2 + hv -> NO + O3 35 | [jch2o_a] CH2O + hv -> CO + 2*HO2 36 | [jch2o_b] CH2O + hv -> CO 37 | [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH 38 | End Photolysis 39 | 40 | Reactions 41 | O3 + OH -> HO2 + O2 ; 1.700E-12, -940 42 | [out6] HO2 + O3 -> 2*O2 + OH ; 1.000E-14, -490 43 | HO2 + OH -> H2O + O2 ; 4.800E-11, 250 44 | [usr_HO2_HO2] HO2 + HO2 -> H2O2 + O2 45 | H2O2 + OH -> H2O + HO2 ; 1.800E-12 46 | NO + O3 -> NO2 + O2 ; 3.000E-12, -1500 47 | HO2 + NO -> NO2 + OH ; 3.500E-12, 250 48 | NO2 + OH + M -> HNO3 ; 1.800E-30, 3.00, 2.800E-11, 0.00, 0.6 49 | CH4 + OH -> CH3O2 + H2O ; 2.450E-12, -1775 50 | [usr_oh_co] CO + OH -> HO2 51 | CH2O + OH -> CO + H2O + HO2 ; 5.500E-12, 125 52 | CH3O2 + HO2 -> CH3OOH + O2 ; 4.100E-13, 750 53 | CH3OOH + OH -> CH3O2 + H2O ; 2.700E-12, 200 54 | CH3OOH + OH -> CH2O + H2O + OH ; 1.100E-12, 200 55 | CH3O2 + NO -> CH2O + HO2 + NO2 ; 2.800E-12, 300 56 | CH3O2 + CH3O2 -> 2*CH2O + 0.80*HO2 ; 9.500E-14, 390 57 | [het_no2_h2o] H2O + NO2 -> 0.50*HNO3 58 | DMS + OH -> SO2 ; 1.100E-11, -240 59 | [usr_oh_dms] DMS + OH -> 0.75*SO2 60 | [tag_so2_oh_m] OH + SO2 + M -> SO4 ; 3.300E-31, 4.30, 1.600E-12, 0.00, 0.6 61 | [aq_so2_h2o2] H2O2 + SO2 -> SO4 62 | [aq_so2_o3] O3 + SO2 -> SO4 63 | End reactions 64 | 65 | Heterogeneous 66 | H2O2, HNO3, CH2O, SO2 67 | End heterogeneous 68 | 69 | Ext forcing 70 | NO2, CO 71 | End Ext Forcing 72 | 73 | END Chemistry 74 | 75 | SIMULATION PARAMETERS 76 | 77 | Version Options 78 | model = cam 79 | machine = intel 80 | architecture = hybrid 81 | vec_ftns = on 82 | multitask = on 83 | namemod = on 84 | modules = on 85 | End Version Options 86 | 87 | End Simulation Parameters 88 | -------------------------------------------------------------------------------- /inputs/cam_fixed_oxidants_modal_aero_cw_7modes_noaerwater.inp: -------------------------------------------------------------------------------- 1 | BEGSIM 2 | output_unit_number = 7 3 | output_file = cam_fixed_oxidants_modal_aero_cw_7modes_noaerwater.doc 4 | procout_path = ../output/ 5 | src_path = ../bkend/ 6 | procfiles_path = ../procfiles/cam/ 7 | sim_dat_path = ../output/ 8 | sim_dat_filename = cam_fixed_oxidants_modal_aero_cw_7modes_noaerwater.dat 9 | 10 | Comments 11 | "This is a mozart4 simulation with :" 12 | "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)" 13 | "(2) New aerosol chemistry" 14 | "(3) No groups" 15 | "(4) NCEP inputs (28 levels)" 16 | "(5) no N atom; no NH4, no H2SO4" 17 | End Comments 18 | 19 | SPECIES 20 | 21 | Solution 22 | H2O2, H2SO4, SO2, DMS -> CH3SCH3, NH3, SOAG -> C 23 | so4_a1 -> SO4, nh4_a1 -> NH4 24 | pom_a1 -> C, soa_a1 -> C, bc_a1 -> C, ncl_a1 -> NaCl 25 | num_a1 -> H 26 | so4_a2 -> SO4, nh4_a2 -> NH4 27 | soa_a2 -> C, ncl_a2 -> NaCl 28 | num_a2 -> H 29 | pom_a3 -> C, bc_a3 -> C 30 | num_a3 -> H 31 | ncl_a4 -> NaCl, so4_a4 -> SO4 32 | nh4_a4 -> NH4, num_a4 -> H 33 | dst_a5 -> AlSiO5, so4_a5 -> SO4 34 | nh4_a5 -> NH4, num_a5 -> H 35 | ncl_a6 -> NaCl, so4_a6 -> SO4 36 | nh4_a6 -> NH4, num_a6 -> H 37 | dst_a7 -> AlSiO5, so4_a7 -> SO4 38 | nh4_a7 -> NH4, num_a7 -> H 39 | End Solution 40 | 41 | Fixed 42 | M, N2, O2, H2O, O3, OH, NO3, HO2 43 | End Fixed 44 | 45 | Col-int 46 | O3 = 0. 47 | O2 = 0. 48 | End Col-int 49 | 50 | End SPECIES 51 | 52 | Solution Classes 53 | Explicit 54 | End Explicit 55 | Implicit 56 | H2O2, H2SO4, SO2, DMS, NH3, SOAG 57 | so4_a1, nh4_a1, pom_a1 58 | soa_a1, bc_a1, ncl_a1, num_a1 59 | so4_a2, nh4_a2, soa_a2, ncl_a2 60 | num_a2 61 | pom_a3, bc_a3, num_a3 62 | ncl_a4, so4_a4, nh4_a4, num_a4 63 | dst_a5, so4_a5, nh4_a5, num_a5 64 | ncl_a6, so4_a6, nh4_a6, num_a6 65 | dst_a7, so4_a7, nh4_a7, num_a7 66 | End Implicit 67 | End Solution Classes 68 | 69 | CHEMISTRY 70 | Photolysis 71 | [jh2o2] H2O2 + hv -> 72 | End Photolysis 73 | 74 | Reactions 75 | [usr9] HO2 + HO2 -> H2O2 76 | H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160 77 | [usr23] SO2 + OH -> H2SO4 78 | DMS + OH -> SO2 ; 9.6e-12, -234. 79 | [usr24] DMS + OH -> .5 * SO2 + .5 * HO2 80 | DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520. 81 | NH3 + OH -> H2O ; 1.7e-12, -710. 82 | End Reactions 83 | 84 | Heterogeneous 85 | H2O2, SO2 86 | End Heterogeneous 87 | 88 | Ext Forcing 89 | SO2 <- dataset 90 | so4_a1 <- dataset 91 | so4_a2 <- dataset 92 | num_a1 <- dataset 93 | num_a2 <- dataset 94 | End Ext Forcing 95 | 96 | END CHEMISTRY 97 | 98 | SIMULATION PARAMETERS 99 | 100 | Version Options 101 | model = cam 102 | machine = intel 103 | architecture = hybrid 104 | vec_ftns = on 105 | multitask = on 106 | namemod = on 107 | modules = on 108 | End Version Options 109 | 110 | END SIMULATION PARAMETERS 111 | 112 | ENDSIM 113 | -------------------------------------------------------------------------------- /src/cam_chempp/srfflx.f: -------------------------------------------------------------------------------- 1 | 2 | subroutine srfflx( lin, & 3 | lout, & 4 | new_nq, & 5 | new_solsym, & 6 | srf_flx_map, & 7 | srf_flx_cnt, & 8 | tag ) 9 | 10 | use var_mod, only : var_lim 11 | 12 | implicit none 13 | 14 | !----------------------------------------------------------------------- 15 | ! ... Dummy args 16 | !----------------------------------------------------------------------- 17 | integer, intent(in) :: lin, & ! input unit number 18 | lout, & ! output unit number 19 | new_nq, & ! species count 20 | tag ! emission or deposition tag ( 1,2 ) 21 | integer, intent(inout) :: srf_flx_cnt ! count of species with srf flux 22 | integer, intent(out) :: srf_flx_map(*) ! srf flux "map" 23 | character(len=16), intent(in) :: new_solsym(*) ! species names 24 | 25 | !----------------------------------------------------------------------- 26 | ! ... Local variables 27 | !----------------------------------------------------------------------- 28 | integer :: nchar 29 | integer :: toklen(20) 30 | integer :: j, k 31 | integer :: no_tokens 32 | 33 | character(len=320) :: buff 34 | character(len=320) :: buffh 35 | character(len=16) :: tokens(20) 36 | 37 | logical :: found 38 | 39 | integer, parameter :: symlen = 8 40 | 41 | !----------------------------------------------------------------------- 42 | ! ... Read the surface flux species 43 | !----------------------------------------------------------------------- 44 | do 45 | call cardin( lin, buff, nchar ) 46 | buffh = buff 47 | call upcase( buffh ) 48 | if( tag == 1 .and. buffh == 'ENDSURFACEFLUX' ) then 49 | exit 50 | else if( tag == 2 .and. buffh == 'ENDSURFACEDEPOSITION' ) then 51 | exit 52 | end if 53 | call gettokens( buff, nchar, ',', symlen, & 54 | tokens, toklen, 20, no_tokens ) 55 | if( no_tokens == 0 ) then 56 | call errmes( ' SRFFLX: Species input line in error@', lout, buff, 1, buff ) 57 | end if 58 | do j = 1,no_tokens 59 | srf_flx_cnt = srf_flx_cnt + 1 60 | if( srf_flx_cnt > var_lim ) then 61 | call errmes( ' SRFFLX: Species count exceeds limit@', lout, buff, 1, buff ) 62 | end if 63 | found = .false. 64 | do k = 1,new_nq 65 | if( tokens(j) == new_solsym(k) ) then 66 | if( srf_flx_cnt > 1 ) then 67 | if( any( srf_flx_map(:srf_flx_cnt) == k ) ) then 68 | if( tag == 1 ) then 69 | call errmes( '# is already in srf emis list@', lout, tokens(j), toklen(j), buff ) 70 | else if( tag == 2 ) then 71 | call errmes( '# is already in dry dep list@', lout, tokens(j), toklen(j), buff ) 72 | end if 73 | end if 74 | end if 75 | srf_flx_map(srf_flx_cnt) = k 76 | found = .true. 77 | exit 78 | end if 79 | end do 80 | if( .not. found ) then 81 | call errmes( '# is not in solution species list@', lout, tokens(j), toklen(j), buff ) 82 | end if 83 | end do 84 | end do 85 | 86 | end subroutine srfflx 87 | -------------------------------------------------------------------------------- /inputs/super_fast_LLNL.in: -------------------------------------------------------------------------------- 1 | SPECIES 2 | 3 | Solution 4 | O3, OH -> HO, HO2, H2O2, NO, NO2, HNO3, CO, CH4, CH2O, CH3O2 5 | CH3OOH -> CH4O2, DMS -> C2H6S, SO2 -> O2S, 6 | SO4 7 | End Solution 8 | 9 | Fixed 10 | M, N2, O2, H2O 11 | End Fixed 12 | 13 | Col-int 14 | O3 = 0. 15 | O2 = 0. 16 | End Col-int 17 | 18 | END Species 19 | 20 | Solution classes 21 | Explicit 22 | CO, CH4 23 | End explicit 24 | Implicit 25 | O3, OH, HO2, H2O2, NO, NO2, HNO3, CH2O, CH3O2, CH3OOH 26 | DMS, SO2, SO4 27 | End implicit 28 | END Solution classes 29 | 30 | CHEMISTRY 31 | Photolysis 32 | *[jo1d] O3 + hv -> 2*OH 33 | [jo1d->,jo3_a] O3 + hv -> 2*OH 34 | [jh2o2] H2O2 + hv -> 2*OH 35 | [jno2] NO2 + hv -> NO + O3 36 | [jch2o_a] CH2O + hv -> CO + 2*HO2 37 | [jch2o_b] CH2O + hv -> CO 38 | [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH 39 | End Photolysis 40 | 41 | Reactions 42 | O3 + OH -> HO2 + O2 ; 1.700E-12, -940 43 | [out6] HO2 + O3 -> 2*O2 + OH ; 1.000E-14, -490 44 | HO2 + OH -> H2O + O2 ; 4.800E-11, 250 45 | [ho2_ho2] HO2 + HO2 -> H2O2 + O2 46 | H2O2 + OH -> H2O + HO2 ; 1.800E-12 47 | NO + O3 -> NO2 + O2 ; 3.000E-12, -1500 48 | HO2 + NO -> NO2 + OH ; 3.500E-12, 250 49 | NO2 + OH + M -> HNO3 ; 1.800E-30, 3.00, 2.800E-11, 0.00, 0.6 50 | CH4 + OH -> CH3O2 + H2O ; 2.450E-12, -1775 51 | [oh_co] CO + OH -> HO2 52 | CH2O + OH -> CO + H2O + HO2 ; 5.500E-12, 125 53 | CH3O2 + HO2 -> CH3OOH + O2 ; 4.100E-13, 750 54 | CH3OOH + OH -> CH3O2 + H2O ; 2.700E-12, 200 55 | CH3OOH + OH -> CH2O + H2O + OH ; 1.100E-12, 200 56 | CH3O2 + NO -> CH2O + HO2 + NO2 ; 2.800E-12, 300 57 | CH3O2 + CH3O2 -> 2*CH2O + 0.80*HO2 ; 9.500E-14, 390 58 | [het_no2_h2o] H2O + NO2 -> 0.50*HNO3 59 | DMS + OH -> SO2 ; 1.100E-11, -240 60 | [oh_dms] DMS + OH -> 0.75*SO2 61 | [so2_oh_m] OH + SO2 + M -> SO4 ; 3.300E-31, 4.30, 1.600E-12, 0.00, 0.6 62 | [aq_so2_h2o2] H2O2 + SO2 -> SO4 63 | [aq_so2_o3] O3 + SO2 -> SO4 64 | End reactions 65 | 66 | Heterogeneous 67 | H2O2, HNO3, CH2O, SO2 68 | End heterogeneous 69 | 70 | Ext forcing 71 | NO2, CO 72 | End Ext Forcing 73 | 74 | END Chemistry 75 | 76 | SIMULATION PARAMETERS 77 | 78 | Version Options 79 | model = cam 80 | machine = intel 81 | architecture = hybrid 82 | vec_ftns = on 83 | multitask = on 84 | namemod = on 85 | modules = on 86 | End Version Options 87 | 88 | End Simulation Parameters 89 | -------------------------------------------------------------------------------- /inputs/super_fast_LLNL.lut.fixed_ch4.in: -------------------------------------------------------------------------------- 1 | SPECIES 2 | 3 | Solution 4 | O3, OH -> HO, HO2, H2O2, NO, NO2, HNO3, CO, CH2O, CH3O2 5 | CH3OOH -> CH4O2, DMS -> C2H6S, SO2 -> O2S, 6 | SO4 7 | End Solution 8 | 9 | Fixed 10 | M, N2, O2, H2O, CH4 11 | End Fixed 12 | 13 | Col-int 14 | O3 = 0. 15 | O2 = 0. 16 | End Col-int 17 | 18 | END Species 19 | 20 | Solution classes 21 | Explicit 22 | CO 23 | End explicit 24 | Implicit 25 | O3, OH, HO2, H2O2, NO, NO2, HNO3, CH2O, CH3O2, CH3OOH 26 | DMS, SO2, SO4 27 | End implicit 28 | END Solution classes 29 | 30 | CHEMISTRY 31 | Photolysis 32 | [jo1d->,jo3_a] O3 + hv -> 2*OH 33 | [jh2o2] H2O2 + hv -> 2*OH 34 | [jno2] NO2 + hv -> NO + O3 35 | [jch2o_a] CH2O + hv -> CO + 2*HO2 36 | [jch2o_b] CH2O + hv -> CO 37 | [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH 38 | End Photolysis 39 | 40 | Reactions 41 | O3 + OH -> HO2 + O2 ; 1.700E-12, -940 42 | [out6] HO2 + O3 -> 2*O2 + OH ; 1.000E-14, -490 43 | HO2 + OH -> H2O + O2 ; 4.800E-11, 250 44 | [ho2_ho2] HO2 + HO2 -> H2O2 + O2 45 | H2O2 + OH -> H2O + HO2 ; 1.800E-12 46 | NO + O3 -> NO2 + O2 ; 3.000E-12, -1500 47 | HO2 + NO -> NO2 + OH ; 3.500E-12, 250 48 | NO2 + OH + M -> HNO3 ; 1.800E-30, 3.00, 2.800E-11, 0.00, 0.6 49 | CH4 + OH -> CH3O2 + H2O ; 2.450E-12, -1775 50 | [oh_co] CO + OH -> HO2 51 | CH2O + OH -> CO + H2O + HO2 ; 5.500E-12, 125 52 | CH3O2 + HO2 -> CH3OOH + O2 ; 4.100E-13, 750 53 | CH3OOH + OH -> CH3O2 + H2O ; 2.700E-12, 200 54 | CH3OOH + OH -> CH2O + H2O + OH ; 1.100E-12, 200 55 | CH3O2 + NO -> CH2O + HO2 + NO2 ; 2.800E-12, 300 56 | CH3O2 + CH3O2 -> 2*CH2O + 0.80*HO2 ; 9.500E-14, 390 57 | [het_no2_h2o] H2O + NO2 -> 0.50*HNO3 58 | DMS + OH -> SO2 ; 1.100E-11, -240 59 | [oh_dms] DMS + OH -> 0.75*SO2 60 | [so2_oh_m] OH + SO2 + M -> SO4 ; 3.300E-31, 4.30, 1.600E-12, 0.00, 0.6 61 | [aq_so2_h2o2] H2O2 + SO2 -> SO4 62 | [aq_so2_o3] O3 + SO2 -> SO4 63 | End reactions 64 | 65 | Heterogeneous 66 | H2O2, HNO3, CH2O, SO2 67 | End heterogeneous 68 | 69 | Ext forcing 70 | NO2, CO 71 | SO2 <- dataset 72 | SO4 <- dataset 73 | End Ext Forcing 74 | 75 | END Chemistry 76 | 77 | SIMULATION PARAMETERS 78 | 79 | Version Options 80 | model = cam 81 | machine = intel 82 | architecture = hybrid 83 | vec_ftns = on 84 | multitask = on 85 | namemod = on 86 | modules = on 87 | End Version Options 88 | 89 | End Simulation Parameters 90 | -------------------------------------------------------------------------------- /procfiles/cam/mo_chem.mod: -------------------------------------------------------------------------------- 1 | 2 | module chem_mods 3 | !-------------------------------------------------------------- 4 | ! ... Basic chemistry parameters and arrays 5 | !-------------------------------------------------------------- 6 | 7 | use shr_kind_mod, only : r8 => shr_kind_r8 8 | 9 | implicit none 10 | 11 | save 12 | 13 | integer, parameter :: phtcnt = PHTCNT, & ! number of photolysis reactions 14 | rxntot = RXNCNT, & ! number of total reactions 15 | gascnt = GASCNT, & ! number of gas phase reactions 16 | nabscol = NCOL, & ! number of absorbing column densities 17 | gas_pcnst = PCNST, & ! number of "gas phase" species 18 | nfs = NFS, & ! number of "fixed" species 19 | relcnt = RELCNT, & ! number of relationship species 20 | grpcnt = GRPCNT, & ! number of group members 21 | nzcnt = IMP_NZCNT, & ! number of non-zero matrix entries 22 | extcnt = EXTCNT, & ! number of species with external forcing 23 | clscnt1 = CLSCNT1, & ! number of species in explicit class 24 | clscnt2 = CLSCNT2, & ! number of species in hov class 25 | clscnt3 = CLSCNT3, & ! number of species in ebi class 26 | clscnt4 = CLSCNT4, & ! number of species in implicit class 27 | clscnt5 = CLSCNT5, & ! number of species in rodas class 28 | indexm = INDEXM, & ! index of total atm density in invariant array 29 | indexh2o = INDEXH2O, & ! index of water vapor density 30 | clsze = CLSZE, & ! loop length for implicit chemistry 31 | rxt_tag_cnt = RXTTAGCNT, & 32 | enthalpy_cnt = ENTHALPYCNT, & 33 | nslvd = NSLVD 34 | 35 | integer :: clscnt(5) = 0 36 | integer :: cls_rxt_cnt(4,5) = 0 37 | integer :: clsmap(gas_pcnst,5) = 0 38 | integer :: permute(gas_pcnst,5) = 0 39 | # if CLSCNT4 != 0 40 | integer :: diag_map(clscnt4) = 0 41 | # elif CLSCNT5 != 0 42 | integer :: diag_map(clscnt5) = 0 43 | # endif 44 | real(r8) :: adv_mass(gas_pcnst) = 0._r8 45 | real(r8) :: crb_mass(gas_pcnst) = 0._r8 46 | real(r8) :: fix_mass(max(1,nfs)) 47 | # if GRPCNT != 0 48 | real(r8) :: nadv_mass(grpcnt) = 0._r8 49 | # endif 50 | real(r8), allocatable :: cph_enthalpy(:) 51 | integer, allocatable :: cph_rid(:) 52 | integer, allocatable :: num_rnts(:) 53 | 54 | integer, allocatable :: rxt_tag_map(:) 55 | real(r8), allocatable :: pht_alias_mult(:,:) 56 | character(len=32), allocatable :: rxt_tag_lst(:) 57 | character(len=16), allocatable :: pht_alias_lst(:,:) 58 | character(len=16) :: inv_lst(max(1,nfs)) 59 | character(len=16) :: extfrc_lst(max(1,extcnt)) 60 | logical :: frc_from_dataset(max(1,extcnt)) 61 | logical :: is_vector 62 | logical :: is_scalar 63 | character(len=16) :: slvd_lst(max(1,nslvd)) 64 | # if VECLEN !=0 65 | integer, parameter :: veclen = VECLEN 66 | # endif 67 | 68 | end module chem_mods 69 | -------------------------------------------------------------------------------- /inputs/super_fast_LLNL.lut.fixed_ch4.isoprene+O3.in: -------------------------------------------------------------------------------- 1 | SPECIES 2 | 3 | Solution 4 | O3, OH -> HO, HO2, H2O2, NO, NO2, HNO3, CO, CH2O, CH3O2 5 | CH3OOH -> CH4O2, DMS -> C2H6S, SO2 -> O2S, 6 | SO4, ISOP -> C5H8 7 | End Solution 8 | 9 | Fixed 10 | M, N2, O2, H2O, CH4 11 | End Fixed 12 | 13 | Col-int 14 | O3 = 0. 15 | O2 = 0. 16 | End Col-int 17 | 18 | END Species 19 | 20 | Solution classes 21 | Explicit 22 | CO 23 | End explicit 24 | Implicit 25 | O3, OH, HO2, H2O2, NO, NO2, HNO3, CH2O, CH3O2, CH3OOH 26 | DMS, SO2, SO4, ISOP 27 | End implicit 28 | END Solution classes 29 | 30 | CHEMISTRY 31 | Photolysis 32 | [jo1d->,jo3_a] O3 + hv -> 2*OH 33 | [jh2o2] H2O2 + hv -> 2*OH 34 | [jno2] NO2 + hv -> NO + O3 35 | [jch2o_a] CH2O + hv -> CO + 2*HO2 36 | [jch2o_b] CH2O + hv -> CO 37 | [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH 38 | End Photolysis 39 | 40 | Reactions 41 | O3 + OH -> HO2 + O2 ; 1.700E-12, -940 42 | [out6] HO2 + O3 -> 2*O2 + OH ; 1.000E-14, -490 43 | HO2 + OH -> H2O + O2 ; 4.800E-11, 250 44 | [usr_HO2_HO2] HO2 + HO2 -> H2O2 + O2 45 | H2O2 + OH -> H2O + HO2 ; 1.800E-12 46 | NO + O3 -> NO2 + O2 ; 3.000E-12, -1500 47 | HO2 + NO -> NO2 + OH ; 3.500E-12, 250 48 | NO2 + OH + M -> HNO3 ; 1.800E-30, 3.00, 2.800E-11, 0.00, 0.6 49 | CH4 + OH -> CH3O2 + H2O ; 2.450E-12, -1775 50 | [usr_oh_co] CO + OH -> HO2 51 | CH2O + OH -> CO + H2O + HO2 ; 5.500E-12, 125 52 | CH3O2 + HO2 -> CH3OOH + O2 ; 4.100E-13, 750 53 | CH3OOH + OH -> CH3O2 + H2O ; 2.700E-12, 200 54 | CH3OOH + OH -> CH2O + H2O + OH ; 1.100E-12, 200 55 | CH3O2 + NO -> CH2O + HO2 + NO2 ; 2.800E-12, 300 56 | CH3O2 + CH3O2 -> 2*CH2O + 0.80*HO2 ; 9.500E-14, 390 57 | [het_no2_h2o] H2O + NO2 -> 0.50*HNO3 58 | DMS + OH -> SO2 ; 1.100E-11, -240 59 | [usr_oh_dms] DMS + OH -> 0.75*SO2 60 | [tag_so2_oh_m] OH + SO2 + M -> SO4 ; 3.300E-31, 4.30, 1.600E-12, 0.00, 0.6 61 | [aq_so2_h2o2] H2O2 + SO2 -> SO4 62 | [aq_so2_o3] O3 + SO2 -> SO4 63 | [isop_oh] ISOP + OH -> 2*CH3O2 -1.5*OH ; 2.700E-11, 390 64 | [isop_o3] ISOP + O3 -> 0.87*CH2O +1.86*CH3O2 +0.06*HO2 +0.05*CO ; 5.590E-15, -1814 65 | End reactions 66 | 67 | Heterogeneous 68 | H2O2, HNO3, CH2O, SO2 69 | End heterogeneous 70 | 71 | Ext forcing 72 | NO2 <- dataset 73 | CO <- dataset 74 | SO2 <- dataset 75 | SO4 <- dataset 76 | End Ext Forcing 77 | 78 | END Chemistry 79 | 80 | SIMULATION PARAMETERS 81 | 82 | Version Options 83 | model = cam 84 | machine = intel 85 | architecture = hybrid 86 | vec_ftns = on 87 | multitask = on 88 | namemod = on 89 | modules = on 90 | End Version Options 91 | 92 | End Simulation Parameters 93 | -------------------------------------------------------------------------------- /src/cam_chempp/job_ctl.f: -------------------------------------------------------------------------------- 1 | subroutine JOB_CTL( lin, & 2 | lout, & 3 | jobctl ) 4 | 5 | implicit none 6 | 7 | !----------------------------------------------------------------------- 8 | ! ... Dummy arguments 9 | !----------------------------------------------------------------------- 10 | integer, intent(in) :: lin, lout 11 | character(len=16), intent(out) :: jobctl(8) ! job control variables 12 | 13 | !----------------------------------------------------------------------- 14 | ! ... Local variables 15 | !----------------------------------------------------------------------- 16 | integer :: kpar, nchar, k 17 | integer :: parsw(8) 18 | 19 | real :: time 20 | 21 | character(len=80) :: buff 22 | character(len=80) :: buffh 23 | character(len=20) :: parkey(8), keywrd 24 | 25 | logical :: found 26 | 27 | integer :: LENOF 28 | 29 | parkey(1) = 'SIMULATIONTIMESTEP' 30 | parkey(2) = 'CRAYTIMELIMIT' 31 | parkey(3) = 'SIMULATIONLENGTH' 32 | parkey(4) = 'CRAYMEMORY' 33 | parkey(5) = 'ACCOUNT' 34 | parkey(6) = 'CASE' 35 | parkey(7) = 'RESTART' 36 | parkey(8) = 'CRAYQUE' 37 | 38 | parsw = 0 39 | 40 | !----------------------------------------------------------------------- 41 | ! ... Scan for valid option keyword 42 | !----------------------------------------------------------------------- 43 | do 44 | call CARDIN( lin, buff, nchar ) 45 | buffh = buff 46 | call UPCASE ( buffh ) 47 | if( buffh == 'ENDJOBCONTROL' ) then 48 | exit 49 | end if 50 | k = INDEX( buffh(:nchar), '=' ) 51 | if( k /= 0 ) then 52 | keywrd = buffh(:k-1) 53 | found = .false. 54 | do kpar = 1,8 55 | if( keywrd == parkey(kpar) ) then 56 | found = .true. 57 | exit 58 | end if 59 | end do 60 | else 61 | !----------------------------------------------------------------------- 62 | ! ... Invalid parameter keyword; terminate the program 63 | !----------------------------------------------------------------------- 64 | call ERRMES ( ' job ctl specification has no = operator@', lout, buff, 1, buff ) 65 | end if 66 | if( .not. found) then 67 | call ERRMES ( ' # is an invalid job control parameter keyword@', & 68 | lout, & 69 | keywrd, & 70 | LENOF(20,keywrd), & 71 | buffh ) 72 | end if 73 | 74 | !----------------------------------------------------------------------- 75 | ! ... Valid parameter keyword; now check for duplicate keyword 76 | !----------------------------------------------------------------------- 77 | if( parsw(kpar) /= 0 ) then 78 | call ERRMES( '0 *** # has already been specified@', lout, parkey(kpar), k, ' ' ) 79 | end if 80 | 81 | !----------------------------------------------------------------------- 82 | ! ... Set individual options 83 | !----------------------------------------------------------------------- 84 | if( kpar <= 3 ) then 85 | if( kpar == 3 ) then 86 | if( buffh(nchar-4:nchar) == 'STEPS' ) then 87 | jobctl(3) = buff(k+1:nchar-5) 88 | else 89 | call TIMCON( buff(k+1:nchar), time, lout ) 90 | jobctl(3) = buff(k+1:nchar) 91 | end if 92 | else 93 | call TIMCON( buff(k+1:nchar), time, lout ) 94 | jobctl(kpar) = buff(k+1:nchar) 95 | end if 96 | else 97 | jobctl(kpar) = buff(k+1:nchar) 98 | end if 99 | parsw(kpar) = 1 100 | end do 101 | 102 | end subroutine JOB_CTL 103 | -------------------------------------------------------------------------------- /inputs/cam_TP1.v2.inp: -------------------------------------------------------------------------------- 1 | BEGSIM 2 | output_unit_number = 7 3 | output_file = cam_aer_nosynoz.doc 4 | procout_path = ../output/ 5 | src_path = ../bkend/ 6 | procfiles_path = ../procfiles/cam/ 7 | sim_dat_path = ../output/ 8 | sim_dat_filename = cam_aer_nosynoz.dat 9 | 10 | Comments 11 | "This is a mozart4 simulation with :" 12 | "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)" 13 | "(2) New aerosol chemistry" 14 | "(3) No groups" 15 | "(4) NCEP inputs (28 levels)" 16 | "(5) no N atom; no NH4, no H2SO4" 17 | End Comments 18 | 19 | SPECIES 20 | 21 | Solution 22 | CO 23 | COEA -> CO 24 | COSA -> CO 25 | COEU -> CO 26 | CONA -> CO 27 | SCO -> CO 28 | SCOEA -> CO 29 | SCOSA -> CO 30 | SCOEU -> CO 31 | SCONA -> CO 32 | COAVOC -> CO 33 | COBVOC -> CO 34 | COCH4 -> CO 35 | CAVOC -> C 36 | CBVOC -> C 37 | PRO1 -> C3H8 38 | BUT1 -> C4H10 39 | ETH1 -> C2H6 40 | PRO2 -> C3H8 41 | BUT2 -> C4H10 42 | ETH2 -> C2H6 43 | LVOC -> C 44 | MVOC -> C 45 | SVOC -> C 46 | End Solution 47 | 48 | Fixed 49 | M, N2, O2, H2O, CH4 50 | End Fixed 51 | 52 | Col-int 53 | End Col-int 54 | 55 | End SPECIES 56 | 57 | Solution Classes 58 | Explicit 59 | CO 60 | COEA 61 | COSA 62 | COEU 63 | CONA 64 | SCO 65 | SCOEA 66 | SCOSA 67 | SCOEU 68 | SCONA 69 | COAVOC 70 | COBVOC 71 | COCH4 72 | CAVOC 73 | CBVOC 74 | PRO1 75 | BUT1 76 | ETH1 77 | PRO2 78 | BUT2 79 | ETH2 80 | LVOC 81 | MVOC 82 | SVOC 83 | End Explicit 84 | Implicit 85 | End Implicit 86 | End Solution Classes 87 | 88 | CHEMISTRY 89 | Photolysis 90 | End Photolysis 91 | 92 | Reactions 93 | CO -> ; 2.3148e-07 94 | COEA -> ; 2.3148e-07 95 | COSA -> ; 2.3148e-07 96 | COEU -> ; 2.3148e-07 97 | CONA -> ; 2.3148e-07 98 | 99 | SCO -> ; 2.3148e-07 100 | SCOEA -> ; 2.3148e-07 101 | SCOSA -> ; 2.3148e-07 102 | SCOEU -> ; 2.3148e-07 103 | SCONA -> ; 2.3148e-07 104 | 105 | COAVOC -> ; 2.3148e-07 106 | COBVOC -> ; 2.3148e-07 107 | COCH4 -> ; 2.3148e-07 108 | 109 | CAVOC -> 0.7*COAVOC ; 1.65344e-06 110 | CBVOC -> 0.4*COBVOC ; 1.15741e-05 111 | CH4 -> 0.86*COCH4 ; 3.73e-09 112 | PRO1 -> ; 0.86e-07 113 | BUT1 -> ; 2.05e-07 114 | ETH1 -> ; 0.18e-07 115 | PRO2 -> ; 1.72e-07 116 | BUT2 -> ; 4.10e-07 117 | ETH2 -> ; 0.36e-07 118 | 119 | LVOC -> ; 1.80845E-07 120 | MVOC -> ; 8.90313E-07 121 | SVOC -> ; 2.0668E-06 122 | 123 | End Reactions 124 | 125 | Heterogeneous 126 | End Heterogeneous 127 | 128 | Ext Forcing 129 | End Ext Forcing 130 | 131 | END CHEMISTRY 132 | 133 | SIMULATION PARAMETERS 134 | 135 | Version Options 136 | model = cam 137 | machine = intel 138 | architecture = hybrid 139 | vec_ftns = on 140 | multitask = on 141 | namemod = on 142 | modules = on 143 | End Version Options 144 | 145 | END SIMULATION PARAMETERS 146 | 147 | ENDSIM 148 | -------------------------------------------------------------------------------- /src/cam_chempp/usrsubs.f: -------------------------------------------------------------------------------- 1 | 2 | subroutine USRSUBS ( sub_names, sub_cnt ) 3 | 4 | use IO 5 | 6 | implicit none 7 | 8 | !----------------------------------------------------------------------- 9 | ! ... Dummy args 10 | !----------------------------------------------------------------------- 11 | integer, intent(out) :: sub_cnt ! count of user subroutines 12 | character(len=128), intent(out) :: sub_names(*) ! user filenames 13 | 14 | !----------------------------------------------------------------------- 15 | ! ... Local variables 16 | !----------------------------------------------------------------------- 17 | integer, parameter :: symlen = 64 18 | 19 | integer :: sublim = 100 20 | integer :: nchar, pos 21 | integer :: toklen(20) 22 | integer :: j, count 23 | integer :: no_tokens 24 | 25 | character(len=64) :: filepath 26 | character(len=128) :: filespec 27 | character(len=64) :: tokens(20) 28 | 29 | logical :: lexist 30 | 31 | sub_cnt = 0 32 | count = 0 33 | filepath = ' ' 34 | filespec = ' ' 35 | !----------------------------------------------------------------------- 36 | ! ... Read the subroutine pathnames 37 | !----------------------------------------------------------------------- 38 | do 39 | call CARDIN ( lin, buff, nchar ) 40 | buffh = buff 41 | call UPCASE( buffh ) 42 | if( buffh /= 'ENDUSERSUBROUTINES' ) then 43 | call GETTOKENS( buff, nchar, ',', symlen, & 44 | tokens, toklen, 20, no_tokens ) 45 | if( no_tokens == 0 ) then 46 | call ERRMES( ' Files input line in error@', lout, buff, 1, ' ' ) 47 | !----------------------------------------------------------------------- 48 | ! ... Check for filepath setting 49 | !----------------------------------------------------------------------- 50 | else if( no_tokens == 1 .and. tokens(1)(9:9) == '=' ) then 51 | filepath = tokens(1)(:8) 52 | call UPCASE( filepath ) 53 | if( filepath == 'FILEPATH' ) then 54 | filepath = tokens(1)(10:) 55 | filepath = TRIM( filepath ) 56 | else 57 | call ERRMES( ' # is not FILEPATH keyword@', lout, tokens(1)(:8), 8, buff ) 58 | end if 59 | cycle 60 | end if 61 | !----------------------------------------------------------------------- 62 | ! ... Process the user subroutine filespec 63 | !----------------------------------------------------------------------- 64 | do j = 1,no_tokens 65 | count = count + 1 66 | if( count > sublim ) then 67 | call ERRMES( ' Files count exceeds limit@', lout, buff, 1, buff ) 68 | end if 69 | if( tokens(j)(1:1) == '/' ) then 70 | filespec = tokens(j)(:toklen(j)) 71 | else 72 | if( filepath /= ' ' ) then 73 | pos = LEN_TRIM(filepath) 74 | if( filepath(pos:pos) /= '/' ) then 75 | filepath(pos+1:pos+1) = '/' 76 | end if 77 | filespec = TRIM( filepath) // tokens(j)(:toklen(j)) 78 | else 79 | filespec = tokens(j)(:toklen(j)) 80 | end if 81 | end if 82 | !----------------------------------------------------------------------- 83 | ! ... Check for file existence 84 | !----------------------------------------------------------------------- 85 | INQUIRE( file = TRIM( filespec ), exist = lexist ) 86 | if( .not. lexist ) then 87 | call ERRMES( ' File # does NOT exist@', lout, filespec, LEN_TRIM(filespec), buff ) 88 | end if 89 | sub_names(count) = filespec 90 | end do 91 | cycle 92 | else 93 | sub_cnt = count 94 | exit 95 | end if 96 | end do 97 | 98 | end subroutine USRSUBS 99 | -------------------------------------------------------------------------------- /src/cam_chempp/num_ctl.f: -------------------------------------------------------------------------------- 1 | 2 | subroutine NUM_CTL( iter_counts ) 3 | 4 | use IO 5 | 6 | implicit none 7 | 8 | !----------------------------------------------------------------------- 9 | ! ... Dummy arguments 10 | !----------------------------------------------------------------------- 11 | integer, intent(inout) :: iter_counts(4) ! iteration counts 12 | 13 | !----------------------------------------------------------------------- 14 | ! ... Local variables 15 | !----------------------------------------------------------------------- 16 | integer, parameter :: max_parm = 4 17 | integer :: kpar, nchar, k 18 | integer :: parsw(max_parm) 19 | integer :: retcod 20 | character(len=20) :: keywrd 21 | character(len=20) :: parkey(max_parm) 22 | logical :: found 23 | 24 | parkey(1) = 'HOVITERATIONS' 25 | parkey(2) = 'IMPLICITITERATIONS' 26 | parkey(3) = 'JACOBIANITERATIONS' 27 | parkey(4) = 'EBIITERATIONS' 28 | 29 | parsw = 0 30 | 31 | !----------------------------------------------------------------------- 32 | ! ... Scan for valid option keyword 33 | !----------------------------------------------------------------------- 34 | do 35 | call CARDIN( lin, buff, nchar ) 36 | buffh = buff 37 | call UPCASE ( buffh ) 38 | if( buffh == 'ENDNUMERICALCONTROL' ) then 39 | exit 40 | end if 41 | k = INDEX( buffh(:nchar), '=' ) 42 | if( k /= 0 ) then 43 | found = .false. 44 | keywrd = buffh(:k-1) 45 | do kpar = 1,max_parm 46 | if( keywrd == parkey(kpar) ) then 47 | found = .true. 48 | exit 49 | end if 50 | end do 51 | else 52 | !----------------------------------------------------------------------- 53 | ! ... Invalid parameter keyword; terminate the program 54 | !----------------------------------------------------------------------- 55 | call ERRMES ( ' Num ctl specification has no = operator@', lout, buff, 1, buff ) 56 | end if 57 | !----------------------------------------------------------------------- 58 | ! ... Invalid parameter keyword; terminate the program 59 | !----------------------------------------------------------------------- 60 | if( .not. found ) then 61 | call ERRMES ( ' # is an invalid Num control parameter keyword@', & 62 | lout, & 63 | keywrd, & 64 | LEN_TRIM(keywrd), & 65 | buffh ) 66 | !----------------------------------------------------------------------- 67 | ! ... Valid parameter keyword; now check for duplicate keyword 68 | !----------------------------------------------------------------------- 69 | else if( parsw(kpar) /= 0 ) then 70 | call ERRMES( '0 *** # has already been specified@', lout, parkey(kpar), k, ' ' ) 71 | end if 72 | 73 | !----------------------------------------------------------------------- 74 | ! ... Set individual iteration counts 75 | !----------------------------------------------------------------------- 76 | call INTCON( buff(k+1:nchar), nchar - k, iter_counts(kpar), retcod ) 77 | !----------------------------------------------------------------------- 78 | ! ... Check itertion limit for validity 79 | !----------------------------------------------------------------------- 80 | if( retcod /= 0 ) then 81 | call ERRMES ( ' # is an invalid iteration count@', & 82 | lout, & 83 | buff(k+1:nchar), & 84 | nchar - k, & 85 | buffh ) 86 | else if( iter_counts(kpar) <= 0 ) then 87 | call ERRMES ( ' # is an invalid iteration count@', & 88 | lout, & 89 | buff(k+1:nchar), & 90 | nchar - k, & 91 | buffh ) 92 | end if 93 | parsw(kpar) = 1 94 | end do 95 | 96 | end subroutine NUM_CTL 97 | -------------------------------------------------------------------------------- /src/cam_chempp/spat_dim.f: -------------------------------------------------------------------------------- 1 | 2 | module MO_SPAT_DIMS 3 | 4 | CONTAINS 5 | 6 | subroutine SPAT_DIMS( buff, dimensions ) 7 | !----------------------------------------------------------------------- 8 | ! ... Set the simulation spatial dimensions 9 | !----------------------------------------------------------------------- 10 | 11 | use IO, only : lin, lout 12 | 13 | implicit none 14 | 15 | !----------------------------------------------------------------------- 16 | ! ... Dummy args 17 | !----------------------------------------------------------------------- 18 | integer, intent(inout) :: dimensions(6) 19 | character(len=80), intent(inout) :: buff 20 | 21 | !----------------------------------------------------------------------- 22 | ! ... Local variables 23 | !----------------------------------------------------------------------- 24 | integer, parameter :: maxparms = 6 25 | integer :: kpar, nchar, retcod, i, k 26 | character(len=20) :: parkey(maxparms), keywrd 27 | logical :: found 28 | logical :: processed(maxparms) 29 | 30 | !----------------------------------------------------------------------- 31 | ! ... Function declarations 32 | !----------------------------------------------------------------------- 33 | integer :: LENOF 34 | 35 | parkey(1) = 'LONGITUDEPOINTS' 36 | parkey(2) = 'LATITUDEPOINTS' 37 | parkey(3) = 'VERTICALPOINTS' 38 | parkey(4) = 'NXPT' 39 | parkey(5) = 'JINTMX' 40 | parkey(6) = 'PLONL' 41 | 42 | processed = .false. 43 | !----------------------------------------------------------------------- 44 | ! ... Scan for valid numerical control parameter keyword 45 | !----------------------------------------------------------------------- 46 | do 47 | call CARDIN( lin, buff, nchar ) 48 | call UPCASE( buff ) 49 | if( buff == 'ENDSPATIALDIMENSIONS' ) then 50 | exit 51 | end if 52 | k = INDEX( buff(:nchar), '=' ) 53 | if( k /= 0 ) then 54 | keywrd = buff(:k-1) 55 | found = .false. 56 | do kpar = 1,maxparms 57 | if( keywrd == parkey(kpar) ) then 58 | found = .true. 59 | exit 60 | end if 61 | end do 62 | if( .not. found ) then 63 | call ERRMES ( ' # is an invalid numerical control' & 64 | // ' parameter keyword@', lout, keywrd, & 65 | LENOF(20,keywrd), buff ) 66 | end if 67 | else 68 | !----------------------------------------------------------------------- 69 | ! ... Invalid parameter keyword; terminate the program 70 | !----------------------------------------------------------------------- 71 | call ERRMES ( ' numerical specification has no = operator@', & 72 | lout, buff, 1, buff ) 73 | end if 74 | 75 | !----------------------------------------------------------------------- 76 | ! ... Valid parameter keyword; now check for duplicate keyword 77 | !----------------------------------------------------------------------- 78 | if( processed(kpar) ) then 79 | call ERRMES( '0 *** # has already been specified@', & 80 | lout, parkey(kpar), k, ' ' ) 81 | end if 82 | call INTCON ( buff(k+1:), & 83 | nchar-k, & 84 | dimensions(kpar), & 85 | retcod ) 86 | !----------------------------------------------------------------------- 87 | ! ... Check for numeric parameter syntax error 88 | !----------------------------------------------------------------------- 89 | if( retcod /= 0 ) then 90 | call ERRMES ( ' # is an invalid real or integer in ' & 91 | // 'numeric controls@', lout, buff(k+1:), & 92 | LENOF( nchar-k, buff(k+1:)), buff ) 93 | end if 94 | processed(kpar) = .true. 95 | end do 96 | 97 | end subroutine SPAT_DIMS 98 | 99 | end module MO_SPAT_DIMS 100 | -------------------------------------------------------------------------------- /inputs/super_fast_modal_3modes.in: -------------------------------------------------------------------------------- 1 | SPECIES 2 | 3 | Solution 4 | O3, OH -> HO, HO2, H2O2, NO, NO2, HNO3, CO, CH2O, CH3O2 5 | CH3OOH -> CH4O2, ISOP -> C5H8 6 | H2SO4, SO2, DMS -> CH3SCH3, SOAG -> C 7 | so4_a1 -> NH4HSO4 8 | pom_a1 -> C 9 | soa_a1 -> C 10 | bc_a1 -> C 11 | dst_a1 -> AlSiO5 12 | ncl_a1 -> NaCl 13 | num_a1 -> H 14 | so4_a2 -> NH4HSO4 15 | soa_a2 -> C 16 | ncl_a2 -> NaCl 17 | num_a2 -> H 18 | dst_a3 -> AlSiO5 19 | ncl_a3 -> NaCl 20 | so4_a3 -> NH4HSO4 21 | num_a3 -> H 22 | End Solution 23 | 24 | Fixed 25 | M, N2, O2, H2O, CH4 26 | End Fixed 27 | 28 | Col-int 29 | O3 = 0. 30 | O2 = 0. 31 | End Col-int 32 | 33 | END Species 34 | 35 | Solution classes 36 | Explicit 37 | CO, SOAG 38 | so4_a1, pom_a1, soa_a1, bc_a1, dst_a1, ncl_a1, num_a1 39 | so4_a2, soa_a2, ncl_a2, num_a2 40 | dst_a3, ncl_a3, so4_a3, num_a3 41 | End explicit 42 | Implicit 43 | O3, OH, HO2, H2O2, NO, NO2, HNO3, CH2O, CH3O2, CH3OOH 44 | DMS, SO2, H2SO4, ISOP 45 | End implicit 46 | END Solution classes 47 | 48 | CHEMISTRY 49 | Photolysis 50 | *[jo1d] O3 + hv -> 2*OH 51 | [jo1d->,jo3_a] O3 + hv -> 2*OH 52 | [jh2o2] H2O2 + hv -> 2*OH 53 | [jno2] NO2 + hv -> NO + O3 54 | [jch2o_a] CH2O + hv -> CO + 2*HO2 55 | [jch2o_b] CH2O + hv -> CO 56 | [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH 57 | End Photolysis 58 | 59 | Reactions 60 | O3 + OH -> HO2 + O2 ; 1.700E-12, -940 61 | [out6] HO2 + O3 -> 2*O2 + OH ; 1.000E-14, -490 62 | HO2 + OH -> H2O + O2 ; 4.800E-11, 250 63 | *[ho2_ho2] HO2 + HO2 -> H2O2 + O2 64 | [usr_HO2_HO2] HO2 + HO2 -> H2O2 65 | H2O2 + OH -> H2O + HO2 ; 1.800E-12 66 | NO + O3 -> NO2 + O2 ; 3.000E-12, -1500 67 | HO2 + NO -> NO2 + OH ; 3.500E-12, 250 68 | NO2 + OH + M -> HNO3 ; 1.800E-30, 3.00, 2.800E-11, 0.00, 0.6 69 | CH4 + OH -> CH3O2 + H2O ; 2.450E-12, -1775 70 | [usr_oh_co] CO + OH -> HO2 71 | CH2O + OH -> CO + H2O + HO2 ; 5.500E-12, 125 72 | CH3O2 + HO2 -> CH3OOH + O2 ; 4.100E-13, 750 73 | CH3OOH + OH -> CH3O2 + H2O ; 2.700E-12, 200 74 | CH3OOH + OH -> CH2O + H2O + OH ; 1.100E-12, 200 75 | CH3O2 + NO -> CH2O + HO2 + NO2 ; 2.800E-12, 300 76 | CH3O2 + CH3O2 -> 2*CH2O + 0.80*HO2 ; 9.500E-14, 390 77 | [het_no2_h2o] H2O + NO2 -> 0.50*HNO3 78 | DMS + OH -> SO2 ; 1.100E-11, -240 79 | *[oh_dms] DMS + OH -> 0.75*SO2 80 | [usr_oh_dms] DMS + OH -> 0.75*SO2 81 | * 82 | * was labeled usr23 in X. Liu's version 83 | * 84 | [usr_SO2_OH] SO2 + OH -> H2SO4 85 | * 86 | [tag_isop_oh] ISOP + OH -> 2*CH3O2 -1.5*OH ; 2.700E-11, 390 87 | [tag_isop_o3] ISOP + O3 -> 0.87*CH2O +1.86*CH3O2 +0.06*HO2 +0.05*CO ; 5.590E-15, -1814 88 | * 89 | End reactions 90 | 91 | Heterogeneous 92 | H2O2, HNO3, CH2O, SO2 93 | End heterogeneous 94 | 95 | Ext forcing 96 | NO2 <- dataset 97 | CO <- dataset 98 | SO2 <- dataset 99 | so4_a1 <- dataset 100 | so4_a2 <- dataset 101 | pom_a1 <- dataset 102 | bc_a1 <- dataset 103 | num_a1 <- dataset 104 | num_a2 <- dataset 105 | End Ext Forcing 106 | 107 | END Chemistry 108 | 109 | SIMULATION PARAMETERS 110 | 111 | Version Options 112 | model = cam 113 | machine = intel 114 | architecture = hybrid 115 | vec_ftns = on 116 | multitask = on 117 | namemod = on 118 | modules = on 119 | End Version Options 120 | 121 | End Simulation Parameters 122 | -------------------------------------------------------------------------------- /procfiles/cam/mo_exp_sol_scalar.F90: -------------------------------------------------------------------------------- 1 | 2 | module mo_exp_sol 3 | 4 | private 5 | public :: exp_sol 6 | public :: exp_sol_inti 7 | 8 | contains 9 | 10 | subroutine exp_sol_inti 11 | 12 | use mo_tracname, only : solsym 13 | use chem_mods, only : clscnt1, clsmap 14 | use ppgrid, only : pver 15 | use cam_history, only : addfld 16 | 17 | implicit none 18 | 19 | integer :: i,j 20 | 21 | do i = 1,clscnt1 22 | 23 | j = clsmap(i,1) 24 | call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' ) 25 | call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' ) 26 | 27 | enddo 28 | end subroutine exp_sol_inti 29 | 30 | 31 | subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop ) 32 | !----------------------------------------------------------------------- 33 | ! ... Exp_sol advances the volumetric mixing ratio 34 | ! forward one time step via the fully explicit 35 | ! Euler scheme 36 | !----------------------------------------------------------------------- 37 | 38 | use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot 39 | use ppgrid, only : pcols, pver 40 | use mo_prod_loss, only : exp_prod_loss 41 | use mo_indprd, only : indprd 42 | use shr_kind_mod, only : r8 => shr_kind_r8 43 | use cam_history, only : outfld 44 | use mo_tracname, only : solsym 45 | 46 | implicit none 47 | !----------------------------------------------------------------------- 48 | ! ... Dummy arguments 49 | !----------------------------------------------------------------------- 50 | integer, intent(in) :: ncol ! columns in chunck 51 | integer, intent(in) :: lchnk ! chunk id 52 | real(r8), intent(in) :: delt ! time step (s) 53 | real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s) 54 | real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) 55 | real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s) 56 | real(r8), intent(in) :: xhnm(ncol,pver) 57 | integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index) 58 | real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr) 59 | 60 | !----------------------------------------------------------------------- 61 | ! ... Local variables 62 | !----------------------------------------------------------------------- 63 | integer :: i, k, l, m 64 | real(r8), dimension(ncol,pver,clscnt1) :: & 65 | prod, & 66 | loss, & 67 | ind_prd 68 | 69 | real(r8), dimension(ncol,pver) :: wrk 70 | 71 | !----------------------------------------------------------------------- 72 | ! ... Put "independent" production in the forcing 73 | !----------------------------------------------------------------------- 74 | call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, & 75 | reaction_rates, ncol ) 76 | 77 | !----------------------------------------------------------------------- 78 | ! ... Form F(y) 79 | !----------------------------------------------------------------------- 80 | call exp_prod_loss( prod, loss, base_sol, reaction_rates, het_rates ) 81 | 82 | !----------------------------------------------------------------------- 83 | ! ... Solve for the mixing ratio at t(n+1) 84 | !----------------------------------------------------------------------- 85 | do m = 1,clscnt1 86 | l = clsmap(m,1) 87 | do i = 1,ncol 88 | do k = ltrop(i)+1,pver 89 | base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m)) 90 | end do 91 | end do 92 | 93 | wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm 94 | call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk ) 95 | wrk(:,:) = (loss(:,:,m))*xhnm 96 | call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk ) 97 | 98 | end do 99 | 100 | end subroutine exp_sol 101 | 102 | end module mo_exp_sol 103 | -------------------------------------------------------------------------------- /procfiles/cam/mo_exp_sol_vector.F90: -------------------------------------------------------------------------------- 1 | 2 | module mo_exp_sol 3 | 4 | private 5 | public :: exp_sol 6 | public :: exp_sol_inti 7 | 8 | contains 9 | 10 | subroutine exp_sol_inti 11 | 12 | use mo_tracname, only : solsym 13 | use chem_mods, only : clscnt1, clsmap 14 | use cam_history, only : addfld 15 | 16 | implicit none 17 | 18 | integer :: i,j 19 | 20 | do i = 1,clscnt1 21 | 22 | j = clsmap(i,1) 23 | call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' ) 24 | call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' ) 25 | 26 | enddo 27 | end subroutine exp_sol_inti 28 | 29 | 30 | subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop ) 31 | !----------------------------------------------------------------------- 32 | ! ... Exp_sol advances the volumetric mixing ratio 33 | ! forward one time step via the fully explicit 34 | ! Euler scheme 35 | !----------------------------------------------------------------------- 36 | 37 | use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot 38 | use ppgrid, only : pcols, pver 39 | use mo_prod_loss, only : exp_prod_loss 40 | use mo_indprd, only : indprd 41 | use shr_kind_mod, only : r8 => shr_kind_r8 42 | use cam_history, only : outfld 43 | use mo_tracname, only : solsym 44 | 45 | implicit none 46 | !----------------------------------------------------------------------- 47 | ! ... Dummy arguments 48 | !----------------------------------------------------------------------- 49 | integer, intent(in) :: ncol ! columns in chunck 50 | integer, intent(in) :: lchnk ! chunk id 51 | real(r8), intent(in) :: delt ! time step (s) 52 | real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s) 53 | real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s) 54 | real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s) 55 | real(r8), intent(in) :: xhnm(ncol,pver) 56 | integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index) 57 | real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr) 58 | 59 | !----------------------------------------------------------------------- 60 | ! ... Local variables 61 | !----------------------------------------------------------------------- 62 | integer :: i, k, l, m 63 | integer :: chnkpnts 64 | real(r8), dimension(ncol,pver,max(1,clscnt1)) :: & 65 | prod, & 66 | loss 67 | real(r8), dimension(ncol,pver,clscnt1) :: ind_prd 68 | 69 | real(r8), dimension(ncol,pver) :: wrk 70 | 71 | chnkpnts = ncol*pver 72 | !----------------------------------------------------------------------- 73 | ! ... Put "independent" production in the forcing 74 | !----------------------------------------------------------------------- 75 | call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, & 76 | reaction_rates, chnkpnts ) 77 | 78 | !----------------------------------------------------------------------- 79 | ! ... Form F(y) 80 | !----------------------------------------------------------------------- 81 | call exp_prod_loss( 1, chnkpnts, prod, loss, base_sol, reaction_rates, & 82 | het_rates, chnkpnts ) 83 | 84 | !----------------------------------------------------------------------- 85 | ! ... Solve for the mixing ratio at t(n+1) 86 | !----------------------------------------------------------------------- 87 | do m = 1,clscnt1 88 | l = clsmap(m,1) 89 | do i = 1,ncol 90 | do k = ltrop(i)+1,pver 91 | base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m)) 92 | end do 93 | end do 94 | 95 | wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm 96 | call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk ) 97 | wrk(:,:) = (loss(:,:,m))*xhnm 98 | call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk ) 99 | 100 | end do 101 | 102 | end subroutine exp_sol 103 | 104 | end module mo_exp_sol 105 | -------------------------------------------------------------------------------- /src/cam_chempp/sparse_pat.f: -------------------------------------------------------------------------------- 1 | 2 | subroutine SPARSITY_PAT( clscnt, & 3 | clsmap, & 4 | cls_rxt_cnt, & 5 | cls_rxt_map, & 6 | sparse_pat ) 7 | !----------------------------------------------------------------------- 8 | ! ... Set the jacobian matrix sparsity pattern 9 | !----------------------------------------------------------------------- 10 | 11 | use VAR_MOD, only : var_lim 12 | use RXT_MOD, only : rxt_lim, prd_lim 13 | 14 | implicit none 15 | 16 | !----------------------------------------------------------------------- 17 | ! ... The arguments 18 | ! 19 | ! The columns of the cls_rxt_cnt represent the reaction count 20 | ! for each class with the following row conontation: 21 | ! (1) - independent reactions 22 | ! (2) - linear reactions 23 | ! (3) - nonlinear reactions 24 | ! (4) - heterogeneous processes 25 | !----------------------------------------------------------------------- 26 | integer, intent(in) :: clscnt, & 27 | clsmap(var_lim), & 28 | cls_rxt_map(rxt_lim,prd_lim+3), & 29 | cls_rxt_cnt(4) 30 | logical, intent(out):: sparse_pat(clscnt,clscnt) 31 | 32 | !----------------------------------------------------------------------- 33 | ! ... Local variables 34 | !----------------------------------------------------------------------- 35 | integer :: i, k, kl, ku, l, m 36 | integer :: target 37 | integer :: species 38 | integer, allocatable :: indexer(:) 39 | logical, allocatable :: match_mask(:,:) 40 | logical, allocatable :: pmask(:,:) 41 | 42 | if( ALLOCATED( match_mask ) ) then 43 | DEALLOCATE( match_mask ) 44 | end if 45 | if( ALLOCATED( pmask ) ) then 46 | DEALLOCATE( pmask ) 47 | end if 48 | if( ALLOCATED( indexer ) ) then 49 | DEALLOCATE( indexer ) 50 | end if 51 | k = SUM( cls_rxt_cnt(:) ) 52 | ALLOCATE( match_mask(k,3) ) 53 | ALLOCATE( indexer(k) ) 54 | if( SUM( cls_rxt_cnt(2:3) ) /= 0 ) then 55 | ALLOCATE( pmask(k,prd_lim) ) 56 | end if 57 | sparse_pat = .false. 58 | do i = 1,clscnt 59 | sparse_pat(i,i) = .true. ! assume only diagonal entries 60 | end do 61 | 62 | Species_loop : & 63 | do species = 1,clscnt 64 | !----------------------------------------------------------------------- 65 | ! ... Check for non-linear losses 66 | !----------------------------------------------------------------------- 67 | target = clsmap(species) 68 | kl = SUM( cls_rxt_cnt(:2) ) + 1 69 | ku = SUM( cls_rxt_cnt(:3) ) 70 | do i = 1,2 71 | match_mask(kl:ku,i) = cls_rxt_map(kl:ku,i+1) == target 72 | where( match_mask(kl:ku,i) ) 73 | indexer(kl:ku) = 6/(i+1) 74 | endwhere 75 | end do 76 | match_mask(kl:ku,1) = match_mask(kl:ku,1) .or. match_mask(kl:ku,2) 77 | if( COUNT( match_mask(kl:ku,1) ) /= 0 ) then 78 | do k = kl,ku 79 | if( match_mask(k,1) ) then 80 | m = ABS( cls_rxt_map(k,indexer(k)) ) 81 | if( m /= target ) then 82 | do i = 1,clscnt 83 | if( clsmap(i) == m ) then 84 | sparse_pat(species,i) = .true. 85 | exit 86 | end if 87 | end do 88 | end if 89 | end if 90 | end do 91 | end if 92 | !----------------------------------------------------------------------- 93 | ! ... Check for production from linear and nonlinear reactions 94 | !----------------------------------------------------------------------- 95 | kl = cls_rxt_cnt(1) + 1 96 | do k = kl,ku 97 | pmask(k,:) = cls_rxt_map(k,4:prd_lim+3) == species 98 | match_mask(k,1) = ANY( pmask(k,:) ) 99 | end do 100 | if( COUNT( match_mask(kl:ku,1) ) /= 0 ) then 101 | do k = kl,ku 102 | if( match_mask(k,1) ) then 103 | do i = 2,3 104 | m = ABS( cls_rxt_map(k,i) ) 105 | if( m /= 0 ) then 106 | do l = 1,clscnt 107 | if( clsmap(l) == m ) then 108 | sparse_pat(species,l) = .true. 109 | exit 110 | end if 111 | end do 112 | end if 113 | end do 114 | end if 115 | end do 116 | end if 117 | end do Species_loop 118 | 119 | if( ALLOCATED( match_mask ) ) then 120 | DEALLOCATE( match_mask ) 121 | end if 122 | if( ALLOCATED( pmask ) ) then 123 | DEALLOCATE( pmask ) 124 | end if 125 | if( ALLOCATED( indexer ) ) then 126 | DEALLOCATE( indexer ) 127 | end if 128 | 129 | end subroutine SPARSITY_PAT 130 | -------------------------------------------------------------------------------- /src/cam_chempp/bndy_conds.f: -------------------------------------------------------------------------------- 1 | 2 | module mo_bndy_conds 3 | 4 | private 5 | public :: bndy_conds 6 | 7 | contains 8 | 9 | subroutine bndy_conds( lin, lout, new_nq, new_solsym, bc_is_fixed, bc_cnt ) 10 | 11 | use var_mod, only : var_lim 12 | 13 | implicit none 14 | 15 | !----------------------------------------------------------------------- 16 | ! ... Dummy args 17 | !----------------------------------------------------------------------- 18 | integer, intent(in) :: lin, & ! input unit number 19 | lout, & ! output unit number 20 | new_nq ! species count 21 | integer, intent(inout) :: bc_cnt(:) ! count of species with fixed bc 22 | logical, intent(inout) :: bc_is_fixed(:,:) ! fixed bndy condition matrix 23 | character(len=16), intent(in) :: new_solsym(:) ! species names 24 | 25 | !----------------------------------------------------------------------- 26 | ! ... Local variables 27 | !----------------------------------------------------------------------- 28 | integer :: nchar 29 | integer :: toklen(20) 30 | integer :: j, k 31 | integer :: no_tokens 32 | integer :: parsw(2) = 0 33 | integer :: bndy 34 | 35 | character(len=320) :: buff 36 | character(len=320) :: buffh 37 | character(len=16) :: tokens(20) 38 | 39 | logical :: found 40 | 41 | integer, parameter :: symlen = 8 42 | 43 | !----------------------------------------------------------------------- 44 | ! ... Read the species boundary conditions 45 | !----------------------------------------------------------------------- 46 | section_loop : & 47 | do 48 | call cardin( lin, buff, nchar ) 49 | buffh = buff 50 | call upcase( buffh ) 51 | if( buffh == 'ENDBNDYCONDS' ) then 52 | exit 53 | end if 54 | if( buffh == 'FIXEDLOWERBC' ) then 55 | bndy = 1 56 | if( parsw(bndy) /= 0 ) then 57 | call errmes( ' BNDY_COND: Fixed Lower BC already specified@', lout, buff, 1, buff ) 58 | end if 59 | else if( buffh == 'FIXEDUPPERBC' ) then 60 | bndy = 2 61 | if( parsw(bndy) /= 0 ) then 62 | call errmes( ' BNDY_COND: Fixed Upper BC already specified@', lout, buff, 1, buff ) 63 | end if 64 | else 65 | call errmes( ' BNDY_COND: # is an invalid keyword @', lout, buff, 1, buff ) 66 | end if 67 | parsw(bndy) = 1 68 | 69 | bndy_loop : & 70 | do 71 | call cardin( lin, buff, nchar ) 72 | buffh = buff 73 | call upcase( buffh ) 74 | if( buffh == 'ENDFIXEDLOWERBC' ) then 75 | if( bndy /= 1 ) then 76 | call errmes( ' BNDY_COND: In Fixed Upper BC @', lout, buff, 1, buff ) 77 | else if( parsw(bndy) /= 1 ) then 78 | call errmes( ' BNDY_COND: Fixed Lower BC not entered@', lout, buff, 1, buff ) 79 | end if 80 | exit 81 | else if( buffh == 'ENDFIXEDUPPERBC' ) then 82 | if( bndy /= 2 ) then 83 | call errmes( ' BNDY_COND: In Fixed Lower BC @', lout, buff, 1, buff ) 84 | else if( parsw(bndy) /= 1 ) then 85 | call errmes( ' BNDY_COND: Fixed Upper BC not entered@', lout, buff, 1, buff ) 86 | end if 87 | exit 88 | end if 89 | call gettokens( buff, nchar, ',', symlen, & 90 | tokens, toklen, 20, no_tokens ) 91 | if( no_tokens == 0 ) then 92 | call errmes( ' BNDY_COND: Species input line in error@', lout, buff, 1, buff ) 93 | end if 94 | token_loop : & 95 | do j = 1,no_tokens 96 | bc_cnt(bndy) = bc_cnt(bndy) + 1 97 | if( bc_cnt(bndy) > var_lim ) then 98 | call errmes( ' BNDY_COND: Species count exceeds limit@', lout, buff, 1, buff ) 99 | end if 100 | found = .false. 101 | do k = 1,new_nq 102 | if( tokens(j) == new_solsym(k) ) then 103 | if( bc_is_fixed(k,bndy) ) then 104 | call errmes( '# is already specified @', lout, tokens(j), toklen(j), buff ) 105 | end if 106 | bc_is_fixed(k,bndy) = .true. 107 | found = .true. 108 | exit 109 | end if 110 | end do 111 | if( .not. found ) then 112 | call errmes( '# is not in solution species list@', lout, tokens(j), toklen(j), buff ) 113 | end if 114 | end do token_loop 115 | end do bndy_loop 116 | end do section_loop 117 | 118 | end subroutine bndy_conds 119 | 120 | end module mo_bndy_conds 121 | -------------------------------------------------------------------------------- /src/cam_chempp/hist_inp.f: -------------------------------------------------------------------------------- 1 | subroutine HIST_INP( lin, & 2 | lout, & 3 | histinp, & 4 | dyn_hst_fld_cnt ) 5 | 6 | implicit none 7 | 8 | !----------------------------------------------------------------------- 9 | ! ... Dummy args 10 | !----------------------------------------------------------------------- 11 | integer, intent(in) :: lin 12 | integer, intent(in) :: lout 13 | integer, intent(out) :: dyn_hst_fld_cnt(2) 14 | character(len=64), intent(out) :: histinp(4) ! hist tape inputs 15 | 16 | !----------------------------------------------------------------------- 17 | ! ... Local variables 18 | !----------------------------------------------------------------------- 19 | integer :: kpar, nchar, k 20 | integer :: retcod, slen 21 | integer :: parsw(6) 22 | real :: time 23 | character(len=80) :: buff 24 | character(len=80) :: buffh 25 | character(len=20) :: parkey(6), keywrd 26 | logical :: found 27 | 28 | integer :: LENOF 29 | 30 | parkey(1) = 'DYNAMICSMSSFILE' 31 | parkey(2) = 'STARTTIME' 32 | parkey(3) = 'ICMSSFILE' 33 | parkey(4) = 'DYNHISTTAPE' 34 | parkey(5) = 'MULTILEVELFIELDS' 35 | parkey(6) = 'SINGLELEVELFIELDS' 36 | 37 | parsw = 0 38 | dyn_hst_fld_cnt = -1 39 | 40 | !----------------------------------------------------------------------- 41 | ! ... Scan for valid option keyword 42 | !----------------------------------------------------------------------- 43 | do 44 | call CARDIN( lin, buff, nchar ) 45 | buffh = buff 46 | call UPCASE ( buffh ) 47 | if( buffh == 'ENDINPUTS' ) then 48 | if( dyn_hst_fld_cnt(1) == -1 .and. dyn_hst_fld_cnt(2) == -1 ) then 49 | if( histinp(4) == 'LONG' ) then 50 | dyn_hst_fld_cnt(1) = 57 51 | dyn_hst_fld_cnt(2) = 44 52 | else if( histinp(4) == 'SHORT' ) then 53 | dyn_hst_fld_cnt(1) = 10 54 | dyn_hst_fld_cnt(2) = 4 55 | end if 56 | end if 57 | exit 58 | end if 59 | k = INDEX( buffh(:nchar), '=' ) 60 | if( k /= 0 ) then 61 | keywrd = buffh(:k-1) 62 | found = .false. 63 | do kpar = 1,6 64 | if( keywrd == parkey(kpar) ) then 65 | found = .true. 66 | exit 67 | end if 68 | end do 69 | if( .not. found ) then 70 | call ERRMES ( ' # is an invalid job control' & 71 | // ' parameter keyword@', & 72 | lout, & 73 | keywrd, & 74 | LENOF(20,keywrd), & 75 | buffh ) 76 | end if 77 | else 78 | !----------------------------------------------------------------------- 79 | ! ... Invalid parameter keyword; terminate the program 80 | !----------------------------------------------------------------------- 81 | call ERRMES ( ' Job ctl specification has no = operator@', & 82 | lout, buff, 1, buff ) 83 | end if 84 | 85 | !----------------------------------------------------------------------- 86 | ! ... Valid parameter keyword; now check for duplicate keyword 87 | !----------------------------------------------------------------------- 88 | if( parsw(kpar) /= 0 ) then 89 | call ERRMES( '0 *** # has already been specified@', & 90 | lout, parkey(kpar), k, ' ' ) 91 | end if 92 | 93 | !----------------------------------------------------------------------- 94 | ! ... Set individual options 95 | !----------------------------------------------------------------------- 96 | if( kpar == 2 ) then 97 | call TIMCON( buff(k+1:nchar), time, lout ) 98 | histinp(2) = buff(k+1:nchar) 99 | else if( kpar == 4 ) then 100 | histinp(4) = buffh(k+1:nchar) 101 | else if( kpar == 5 ) then 102 | slen = LEN_TRIM( buff(k+1:nchar) ) 103 | call INTCON( buff(k+1:nchar), slen, dyn_hst_fld_cnt(1), retcod ) 104 | if( retcod /= 0 .or. dyn_hst_fld_cnt(1) < 0 ) then 105 | call ERRMES ( ' # is an invalid Dyn hst tape field count@', & 106 | lout, & 107 | buff(k+1:nchar), & 108 | slen, & 109 | buffh ) 110 | end if 111 | else if( kpar == 6 ) then 112 | slen = LEN_TRIM( buff(k+1:nchar) ) 113 | call INTCON( buff(k+1:nchar), slen, dyn_hst_fld_cnt(2), retcod ) 114 | if( retcod /= 0 .or. dyn_hst_fld_cnt(2) < 0 ) then 115 | call ERRMES ( ' Dyn hst tape has invalid field count@', & 116 | lout, & 117 | buff(k+1:nchar), & 118 | slen, & 119 | buffh ) 120 | end if 121 | else 122 | histinp(kpar) = buff(k+1:nchar) 123 | end if 124 | parsw(kpar) = 1 125 | end do 126 | 127 | end subroutine HIST_INP 128 | -------------------------------------------------------------------------------- /src/cam_chempp/ver_hdr.f: -------------------------------------------------------------------------------- 1 | 2 | module mo_ver_hdr 3 | 4 | contains 5 | 6 | subroutine ver_hdr( options, & 7 | plon, plonl, plev, & 8 | machine, & 9 | model, & 10 | arch_type, & 11 | ohstflag, & 12 | diagprnt, & 13 | tavgprnt, & 14 | srf_flx_cnt, & 15 | hetcnt, rxntot, clscnt, nzcnt, spcno, & 16 | dvel_cnt ) 17 | 18 | implicit none 19 | 20 | !----------------------------------------------------------------------- 21 | ! ... The arguments 22 | !----------------------------------------------------------------------- 23 | integer, intent(in) :: srf_flx_cnt ! species with srf flux 24 | integer, intent(in) :: dvel_cnt ! species with dep vel 25 | integer, intent(in) :: plon, plonl, plev 26 | integer, intent(in) :: hetcnt, rxntot, spcno 27 | integer, intent(in) :: nzcnt(2) 28 | integer, intent(in) :: clscnt(5) 29 | character(len=16), intent(in) :: machine ! target machine 30 | character(len=16), intent(in) :: model ! target model 31 | character(len=16), intent(in) :: arch_type ! architecture 32 | logical, intent(in) :: options(*) ! options array 33 | logical, intent(in) :: ohstflag ! hist tape write flag 34 | logical, intent(in) :: diagprnt ! chktrc, negtrc diag printout flag 35 | logical, intent(in) :: tavgprnt ! time averaged printout flag 36 | 37 | !----------------------------------------------------------------------- 38 | ! ... The local variables 39 | !----------------------------------------------------------------------- 40 | integer :: i, cache_factor 41 | integer :: up_bound(2) 42 | logical :: lexist 43 | 44 | inquire( file = 'version.h', exist = lexist ) 45 | if( lexist ) then 46 | call system( 'rm version.h' ) 47 | end if 48 | open( unit = 30, file = 'version.h' ) 49 | 50 | if( options(1) ) then 51 | write(30,'(''# define CHEM'')') 52 | end if 53 | 54 | if( options(2) ) then 55 | write(30,'(''# define CRAY'')') 56 | end if 57 | 58 | if( ohstflag ) then 59 | write(30,'(''# define HISTTAPE'')') 60 | end if 61 | 62 | if( diagprnt ) then 63 | write(30,'(''# define DIAGPRNT'')') 64 | end if 65 | 66 | if( tavgprnt ) then 67 | write(30,'(''# define TAVGPRNT'')') 68 | end if 69 | 70 | if( options(12) ) then 71 | write(30,'(''# define RXTNLOOKUP'')') 72 | end if 73 | 74 | if( options(14) ) then 75 | write(30,'(''# define F90'')') 76 | end if 77 | 78 | if( options(16) ) then 79 | write(30,'(''# define USRHOOK'')') 80 | end if 81 | 82 | if( options(17) ) then 83 | write(30,'(''# define MODULES'')') 84 | end if 85 | 86 | if( srf_flx_cnt /= 0 ) then 87 | write(30,'(''# define SFLUX'')') 88 | end if 89 | 90 | if( dvel_cnt /= 0 ) then 91 | write(30,'(''# define DVEL'')') 92 | end if 93 | 94 | select case( machine ) 95 | case( 'INTEL' ) 96 | write(30,'(''# define CLSZE 1'')') 97 | write(30,'(''# define MACHINE_INTEL'')') 98 | case( 'ALPHA', 'IBM' ) 99 | do i = 1,2 100 | up_bound(i) = 2*nzcnt(i) + rxntot + hetcnt + 6*clscnt(i+3) + spcno 101 | up_bound(i) = CEILING( 8.*1024./REAL(up_bound(i)) ) 102 | end do 103 | i = MINVAL( up_bound(:) ) 104 | up_bound(1) = i 105 | do i = 2,up_bound(1) 106 | if( MOD( plonl,i) == 0 ) then 107 | cache_factor = i 108 | end if 109 | end do 110 | write(30,'(''# define CLSZE '',i3)') MAX( 1,cache_factor ) 111 | if( machine == 'IBM' ) then 112 | write(30,'(''# define MACHINE_IBM'')') 113 | else 114 | write(30,'(''# define MACHINE_ALPHA'')') 115 | end if 116 | case( 'CRAY': 'CRAYYMP', 'J90', 'C90' ) 117 | write(30,'(''# define CLSZE '',i3)') plon 118 | write(30,'(''# define MACHINE CRAY'')') 119 | case( 'NEC', 'FUJITSU' ) 120 | ! write(30,'(''# define CLSZE '',i5)') plon*plev 121 | write(30,'(''# define CLSZE 1'')') 122 | if( machine == 'NEC' ) then 123 | write(30,'(''# define MACHINE_NEC'')') 124 | else 125 | write(30,'(''# define MACHINE_FUJITSU'')') 126 | end if 127 | case default 128 | if( arch_type == 'HYBRID' ) then 129 | write(30,'(''# define CLSZE 4'')') 130 | else 131 | write(30,'(''# define CLSZE '',i3)') plon 132 | end if 133 | end select 134 | if( model == 'MOZART' ) then 135 | write(30,'(''# define MOZART '')') 136 | else if( model == 'MOZART' ) then 137 | write(30,'(''# define CAM '')') 138 | end if 139 | 140 | close(30) 141 | 142 | end subroutine ver_hdr 143 | 144 | end module mo_ver_hdr 145 | -------------------------------------------------------------------------------- /inputs/kmg_CAM3_input_deck_T6_v4.inp: -------------------------------------------------------------------------------- 1 | BEGSIM 2 | output_unit_number = 7 3 | output_file = T6_LLNL_v4.doc 4 | procout_path = ../output/ 5 | src_path = ../bkend/ 6 | procfiles_path = ../procfiles/cam/ 7 | sim_dat_path = ../output/ 8 | sim_dat_filename = T6_LLNL_v4.dat 9 | 10 | COMMENTS 11 | "!=======================================================================" 12 | "!" 13 | "! $Id: kmg_CAM3_input_deck.inp $" 14 | "!" 15 | "! CODE DEVELOPER" 16 | "! Name and affiliation" 17 | "! connell2@llnl.gov" 18 | "!" 19 | "! FILE" 20 | "! kmg_CAM3_input_deck.inp" 21 | "!" 22 | "! DESCRIPTION" 23 | "! This file is the mechanism input file." 24 | "!" 25 | "! Chemistry input file: T6 12:00PM 7/09/2008" 26 | "! Reaction dictionary: Rxns_trop_strat_JPL06-2.db" 27 | "! Setkin files generated: Thu Aug 21 18:18:20 2008" 28 | "!" 29 | "!=======================================================================" 30 | End COMMENTS 31 | 32 | SPECIES 33 | 34 | Solution 35 | O3, OH -> HO, HO2, H2O2, NO, NO2, HNO3, CO, CH4, CH2O, CH3O2 36 | CH3OOH -> CH4O2, DMS -> C2H6S, SO2 -> O2S, 37 | SO4 38 | End Solution 39 | 40 | Fixed 41 | M, N2, O2, H2O, OZONE, sulf, bcar1, bcar2, ocar1, ocar2, 42 | sslt1, sslt2, sslt3, sslt4, dust1, dust2, dust3, dust4 43 | End Fixed 44 | 45 | Col-int 46 | O3 = 0. 47 | O2 = 0. 48 | End Col-int 49 | 50 | END Species 51 | 52 | Solution classes 53 | Explicit 54 | CO, CH4 55 | End explicit 56 | Implicit 57 | O3, OH, HO2, H2O2, NO, NO2, HNO3, CH2O, CH3O2, CH3OOH 58 | DMS, SO2, SO4 59 | End implicit 60 | END Solution classes 61 | 62 | CHEMISTRY 63 | Photolysis 64 | [jo1d] O3 + hv -> 2*OH 65 | [jh2o2] H2O2 + hv -> 2*OH 66 | [jno2] NO2 + hv -> NO + O3 67 | [jch2o_a] CH2O + hv -> CO + 2*HO2 68 | [jch2o_b] CH2O + hv -> CO 69 | [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH 70 | End Photolysis 71 | 72 | Reactions 73 | O3 + OH -> HO2 + O2 ; 1.700E-12, -940 74 | [out6] HO2 + O3 -> 2*O2 + OH ; 1.000E-14, -490 75 | HO2 + OH -> H2O + O2 ; 4.800E-11, 250 76 | [ho2_ho2] HO2 + HO2 -> H2O2 + O2 77 | H2O2 + OH -> H2O + HO2 ; 1.800E-12 78 | NO + O3 -> NO2 + O2 ; 3.000E-12, -1500 79 | HO2 + NO -> NO2 + OH ; 3.500E-12, 250 80 | NO2 + OH + M -> HNO3 ; 1.800E-30, 3.00, 2.800E-11, 0.00, 0.6 81 | CH4 + OH -> CH3O2 + H2O ; 2.450E-12, -1775 82 | [oh_co] CO + OH -> HO2 83 | CH2O + OH -> CO + H2O + HO2 ; 5.500E-12, 125 84 | CH3O2 + HO2 -> CH3OOH + O2 ; 4.100E-13, 750 85 | CH3OOH + OH -> CH3O2 + H2O ; 2.700E-12, 200 86 | CH3OOH + OH -> CH2O + H2O + OH ; 1.100E-12, 200 87 | CH3O2 + NO -> CH2O + HO2 + NO2 ; 2.800E-12, 300 88 | CH3O2 + CH3O2 -> 2*CH2O + 0.80*HO2 ; 9.500E-14, 390 89 | [het_no2_h2o] H2O + NO2 -> 0.50*HNO3 90 | DMS + OH -> SO2 ; 1.100E-11, -240 91 | [oh_dms] DMS + OH -> 0.75*SO2 92 | [so2_oh_m] OH + SO2 + M -> SO4 ; 3.300E-31, 4.30, 1.600E-12, 0.00, 0.6 93 | [aq_so2_h2o2] H2O2 + SO2 -> SO4 94 | [aq_so2_o3] O3 + SO2 -> SO4 95 | End reactions 96 | 97 | Heterogeneous 98 | H2O2, HNO3, CH2O, SO2 99 | End heterogeneous 100 | 101 | Ext forcing 102 | NO2, CO 103 | End Ext Forcing 104 | 105 | END Chemistry 106 | 107 | SIMULATION PARAMETERS 108 | Spatial Dimensions 109 | Longitude points = 128 110 | Latitude points = 64 111 | Vertical points = 66 112 | End Spatial Dimensions 113 | 114 | Numerical Control 115 | Implicit Iterations = 11 116 | End Numerical Control 117 | 118 | Surface Flux 119 | 120 | End Surface Flux 121 | 122 | Surface Deposition 123 | O3, OH, HO2, H2O2, NO, NO2, HNO3, CO, CH2O, CH3O2, CH3OOH 124 | SO4 125 | End Surface Deposition 126 | 127 | Version Options 128 | machine = ibm 129 | model = cam 130 | model_architecture = SCALAR 131 | architecture = hybrid 132 | * vec_ftns = on 133 | namemod = on 134 | End Version Options 135 | 136 | Outputs 137 | File 138 | Transported Species = avrg 139 | All 140 | End Transported Species 141 | Surface Flux = avrg 142 | 143 | End Surface Flux 144 | Deposition velocity = avrg 145 | O3, OH, HO2, H2O2, NO, NO2, HNO3, CO, CH2O, CH3O2, CH3OOH 146 | SO4 147 | End Deposition velocity 148 | External Forcing = avrg 149 | 150 | End External Forcing 151 | End File 152 | End Outputs 153 | 154 | End Simulation Parameters 155 | 156 | ENDSIM 157 | -------------------------------------------------------------------------------- /src/Makefile: -------------------------------------------------------------------------------- 1 | #----------------------------------------------------------------------- 2 | # This Makefile is for building MOZART2 Pre-processor 3 | #------------------------------------------------------------------------ 4 | 5 | # Set up special characters 6 | null := 7 | space := $(null) $(null) 8 | 9 | # Check for directory in which to put executable 10 | ifeq ($(MODEL_EXEDIR),$(null)) 11 | MODEL_EXEDIR := ../bin 12 | endif 13 | 14 | # Check for name of executable 15 | ifeq ($(EXENAME),$(null)) 16 | EXENAME := campp 17 | endif 18 | 19 | # Check for source list 20 | ifeq ($(SRCLIST),$(null)) 21 | SRCLIST := Base_Srclist_f 22 | endif 23 | 24 | ifeq ($(OBJ_DIR),$(null)) 25 | OBJ_DIR := ./OBJ 26 | endif 27 | 28 | # Load dependency search path. 29 | # Check for source directories 30 | ifeq ($(SRCDIRS),$(null)) 31 | dirs := ./cam_chempp 32 | else 33 | dirs := ./ $(SRCDIRS) 34 | endif 35 | 36 | # Determine platform 37 | UNAMES := $(shell uname -s) 38 | UNAMEM := $(shell uname -m) 39 | 40 | # Set cpp search path, include netcdf 41 | cpp_dirs := $(dirs) 42 | cpp_path := $(foreach dir,$(cpp_dirs),-I$(dir)) # format for command line 43 | 44 | # Expand any tildes in directory names. Change spaces to colons. 45 | VPATH := $(foreach dir,$(cpp_dirs),$(dir)) 46 | VPATH := $(subst $(space),:,$(VPATH)) 47 | 48 | # Get list of files and determine objects and dependency files 49 | base_srclist_f := $(shell cat $(SRCLIST)) 50 | OBJS := $(foreach file,$(base_srclist_f),$(OBJ_DIR)/$(file:.f=.o)) 51 | 52 | all: $(MODEL_EXEDIR)/$(EXENAME) 53 | 54 | #------------------------------------------------------------------------ 55 | #------------------------------------------------------------------------ 56 | #------------------------------------------------------------------------ 57 | 58 | # guess default compiler 59 | ifeq ($(USER_FC),$(null)) 60 | 61 | #------------------------------------------------------------------------ 62 | # Linux -- including pleiades 63 | #------------------------------------------------------------------------ 64 | ifeq ($(UNAMES),Linux) 65 | USER_FC := gfortran 66 | endif 67 | #------------------------------------------------------------------------ 68 | # Altix (columbia) 69 | #------------------------------------------------------------------------ 70 | ifeq ($(UNAMEM),ia64) 71 | USER_FC := ifort 72 | endif 73 | #------------------------------------------------------------------------ 74 | # Alpha 75 | #------------------------------------------------------------------------ 76 | ifeq ($(UNAMEM),alpha) 77 | USER_FC := f95 78 | endif 79 | #------------------------------------------------------------------------ 80 | # AIX ? 81 | #------------------------------------------------------------------------ 82 | ifeq ($(UNAMES),AIX) 83 | USER_FC := xlf95 84 | endif 85 | #------------------------------------------------------------------------ 86 | # BG/L, BG/P 87 | #------------------------------------------------------------------------ 88 | ifeq ($(UNAMEM),ppc64) 89 | USER_FC := xlf95 90 | endif 91 | #------------------------------------------------------------------------ 92 | # SGI 93 | #------------------------------------------------------------------------ 94 | ifeq ($(UNAMES),IRIX64) 95 | USER_FC := f90 96 | MACHFLGS := -OPT:Olimit=8200 97 | endif 98 | 99 | #------------------------------------------------------------------------ 100 | #------------------------------------------------------------------------ 101 | 102 | endif 103 | 104 | #------------------------------------------------------------------------ 105 | #------------------------------------------------------------------------ 106 | # set compiler flags ... 107 | #------------------------------------------------------------------------ 108 | ifeq ($(USER_FC),ifort) 109 | FFLAGS := -O2 -c -132 -ftz -g -FR -I $(OBJ_DIR) 110 | ifeq ($(DEBUG),TRUE) 111 | FFLAGS += -CB 112 | endif 113 | endif 114 | ifeq ($(USER_FC),lf95) 115 | ifeq ($(DEBUG),TRUE) 116 | FFLAGS := --nfix --nap --chk --g --npca --nsav --trace --trap -c --mod $(OBJ_DIR) -O 117 | else 118 | FFLAGS := --nfix --nap --nchk --ng --npca --nsav --ntrace -c --mod $(OBJ_DIR) -O2 119 | endif 120 | endif 121 | ifeq ($(USER_FC),pgf90) 122 | FFLAGS := -O1 -c -g -Mfree -module $(OBJ_DIR) 123 | ifeq ($(DEBUG),TRUE) 124 | FFLAGS += -C 125 | endif 126 | endif 127 | ifeq ($(USER_FC),pgf95) 128 | FFLAGS := -O1 -c -g -Mfree -module $(OBJ_DIR) 129 | ifeq ($(DEBUG),TRUE) 130 | FFLAGS += -C 131 | endif 132 | endif 133 | ifeq ($(USER_FC),f90) 134 | FFLAGS := -c -freeform -I $(OBJ_DIR) -O2 $(MACHFLGS) 135 | endif 136 | ifeq ($(USER_FC),f95) 137 | FFLAGS := -O4 -c -tune host -arch host -free -module $(OBJ_DIR) -I $(OBJ_DIR) 138 | endif 139 | ifeq ($(USER_FC),xlf95) 140 | FFLAGS := -g -c -qarch=auto -qnosave -qfree=f90 -qmoddir=$(OBJ_DIR) -I $(OBJ_DIR) -qstrict -O3 141 | endif 142 | ifeq ($(USER_FC),gfortran) 143 | FFLAGS := -g -c -ffree-form 144 | endif 145 | ifeq ($(USER_FC),g95) 146 | FFLAGS := -g -c -ffree-form 147 | endif 148 | 149 | #------------------------------------------------------------------------ 150 | #------------------------------------------------------------------------ 151 | #------------------------------------------------------------------------ 152 | 153 | FC := $(USER_FC) 154 | 155 | #------------------------------------------------------------------------ 156 | # Default rules 157 | #------------------------------------------------------------------------ 158 | 159 | .SUFFIXES: 160 | .SUFFIXES: .f .F .c .o 161 | 162 | $(OBJ_DIR)/%.o : %.f 163 | $(FC) $(FFLAGS) -o $@ $< 164 | 165 | $(MODEL_EXEDIR)/$(EXENAME): $(OBJS) 166 | $(FC) -o $@ $(OBJS) $(LDFLAGS) 167 | 168 | RM := rm 169 | 170 | clean: 171 | $(RM) -f $(OBJ_DIR)/*.o $(OBJ_DIR)/*.mod $(MODEL_EXEDIR)/$(EXENAME) 172 | 173 | realclean: 174 | $(RM) -f $(OBJ_DIR)/*.o *.d $(MODEL_EXEDIR)/$(EXENAME) 175 | -------------------------------------------------------------------------------- /procfiles/mo_chem.mod: -------------------------------------------------------------------------------- 1 | 2 | module chem_mods 3 | !-------------------------------------------------------------- 4 | ! ... basic chemistry array parameters 5 | !-------------------------------------------------------------- 6 | 7 | use mo_grid, only : pcnstm1 8 | 9 | implicit none 10 | 11 | save 12 | 13 | integer, parameter :: hetcnt = HETCNT, & ! number of heterogeneous processes 14 | phtcnt = PHTCNT, & ! number of photo processes 15 | rxntot = RXNCNT, & ! number of total reactions 16 | gascnt = GASCNT, & ! number of gas phase reactions 17 | nfs = NFS, & ! number of "fixed" species 18 | relcnt = RELCNT, & ! number of relationship species 19 | grpcnt = GRPCNT, & ! number of group members 20 | imp_nzcnt = IMP_NZCNT, & ! number of non-zero implicit matrix entries 21 | rod_nzcnt = ROD_NZCNT, & ! number of non-zero rodas matrix entries 22 | extcnt = EXTCNT, & ! number of species with external forcing 23 | clscnt1 = CLSCNT1, & ! number of species in explicit class 24 | clscnt2 = CLSCNT2, & ! number of species in hov class 25 | clscnt3 = CLSCNT3, & ! number of species in ebi class 26 | clscnt4 = CLSCNT4, & ! number of species in implicit class 27 | clscnt5 = CLSCNT5, & ! number of species in rodas class 28 | indexm = INDEXM, & ! index of total atm density in invariant array 29 | ncol_abs = NCOL, & ! number of column densities 30 | indexh2o = INDEXH2O, & ! index of water vapor density 31 | clsze = CLSZE ! loop length for implicit chemistry 32 | 33 | integer :: ngrp = 0 34 | integer :: drydep_cnt = 0 35 | integer :: srfems_cnt = 0 36 | integer :: rxt_alias_cnt = 0 37 | integer :: fbc_cnt(2) = 0 38 | integer, allocatable :: grp_mem_cnt(:) 39 | integer, allocatable :: rxt_alias_map(:) 40 | real :: adv_mass(pcnstm1) 41 | real :: nadv_mass(grpcnt) 42 | character(len=16), allocatable :: rxt_alias_lst(:) 43 | character(len=8), allocatable :: drydep_lst(:) 44 | character(len=8), allocatable :: srfems_lst(:) 45 | character(len=8), allocatable :: grp_lst(:) 46 | character(len=8), allocatable :: flbc_lst(:) 47 | character(len=8) :: het_lst(max(1,hetcnt)) 48 | character(len=8) :: extfrc_lst(max(1,extcnt)) 49 | character(len=8) :: inv_lst(max(1,nfs)) 50 | 51 | type solver_class 52 | integer :: clscnt 53 | integer :: lin_rxt_cnt 54 | integer :: nln_rxt_cnt 55 | integer :: indprd_cnt 56 | integer :: iter_max 57 | integer :: cls_rxt_cnt(4) 58 | integer, pointer :: permute(:) 59 | integer, pointer :: diag_map(:) 60 | integer, pointer :: clsmap(:) 61 | end type solver_class 62 | 63 | type(solver_class) :: explicit, implicit, rodas 64 | 65 | contains 66 | 67 | subroutine chem_mods_inti 68 | !-------------------------------------------------------------- 69 | ! ... intialize the class derived type 70 | !-------------------------------------------------------------- 71 | 72 | implicit none 73 | 74 | integer :: astat 75 | 76 | explicit%clscnt = CLSCNT1 77 | explicit%indprd_cnt = CLSINDPRD1 78 | 79 | implicit%clscnt = CLSCNT4 80 | implicit%lin_rxt_cnt = IMP_LINCNT 81 | implicit%nln_rxt_cnt = IMP_NLNCNT 82 | implicit%indprd_cnt = CLSINDPRD4 83 | implicit%iter_max = IMPITERMAX 84 | 85 | rodas%clscnt = CLSCNT5 86 | rodas%lin_rxt_cnt = ROD_LINCNT 87 | rodas%nln_rxt_cnt = ROD_NLNCNT 88 | rodas%indprd_cnt = CLSINDPRD5 89 | 90 | if( explicit%clscnt > 0 ) then 91 | allocate( explicit%clsmap(explicit%clscnt),stat=astat ) 92 | if( astat /= 0 ) then 93 | write(*,*) 'chem_mods_inti: failed to allocate explicit%clsmap ; error = ',astat 94 | call endrun 95 | end if 96 | explicit%clsmap(:) = 0 97 | end if 98 | if( implicit%clscnt > 0 ) then 99 | allocate( implicit%permute(implicit%clscnt),stat=astat ) 100 | if( astat /= 0 ) then 101 | write(*,*) 'chem_mods_inti: failed to allocate implicit%permute ; error = ',astat 102 | call endrun 103 | end if 104 | implicit%permute(:) = 0 105 | allocate( implicit%diag_map(implicit%clscnt),stat=astat ) 106 | if( astat /= 0 ) then 107 | write(*,*) 'chem_mods_inti: failed to allocate implicit%diag_map ; error = ',astat 108 | call endrun 109 | end if 110 | implicit%diag_map(:) = 0 111 | allocate( implicit%clsmap(implicit%clscnt),stat=astat ) 112 | if( astat /= 0 ) then 113 | write(*,*) 'chem_mods_inti: failed to allocate implicit%clsmap ; error = ',astat 114 | call endrun 115 | end if 116 | implicit%clsmap(:) = 0 117 | end if 118 | if( rodas%clscnt > 0 ) then 119 | allocate( rodas%permute(rodas%clscnt),stat=astat ) 120 | if( astat /= 0 ) then 121 | write(*,*) 'chem_mods_inti: failed to allocate rodas%permute ; error = ',astat 122 | call endrun 123 | end if 124 | rodas%permute(:) = 0 125 | allocate( rodas%diag_map(rodas%clscnt),stat=astat ) 126 | if( astat /= 0 ) then 127 | write(*,*) 'chem_mods_inti: failed to allocate rodas%diag_map ; error = ',astat 128 | call endrun 129 | end if 130 | rodas%diag_map(:) = 0 131 | allocate( rodas%clsmap(rodas%clscnt),stat=astat ) 132 | if( astat /= 0 ) then 133 | write(*,*) 'chem_mods_inti: failed to allocate rodas%clsmap ; error = ',astat 134 | call endrun 135 | end if 136 | rodas%clsmap(:) = 0 137 | end if 138 | 139 | end subroutine chem_mods_inti 140 | 141 | end module chem_mods 142 | -------------------------------------------------------------------------------- /src/cam_chempp/chm_hdr.f: -------------------------------------------------------------------------------- 1 | 2 | subroutine chm_hdr( rxt_tag_cnt, enthalpy_cnt, hetcnt, usrcnt, cls_rxt_cnt, radj_flag, phtcnt, & 3 | rxpcnt, rxparm, rxntot, ncol, nfs, nslvd, & 4 | indexm, indexh2o, spcno, relcnt, grpcnt, & 5 | clscnt, iter_counts, nzcnt, vec_ftns, machine, chemistry, veclen ) 6 | !----------------------------------------------------------------------- 7 | ! ... Write the chemistry "header" file 8 | !----------------------------------------------------------------------- 9 | 10 | implicit none 11 | 12 | !----------------------------------------------------------------------- 13 | ! ... Dummy arguments 14 | !----------------------------------------------------------------------- 15 | integer, intent(in) :: rxt_tag_cnt 16 | integer, intent(in) :: enthalpy_cnt 17 | integer, intent(in) :: hetcnt ! count of washout processes 18 | integer, intent(in) :: usrcnt ! count of extraneous forcing 19 | integer, intent(in) :: phtcnt ! count of photorates 20 | integer, intent(in) :: rxpcnt ! count of specified rates 21 | integer, intent(in) :: rxntot ! count of totol reactions 22 | integer, intent(in) :: ncol ! number of column integrals 23 | integer, intent(in) :: nfs ! number of "fixed" species 24 | integer, intent(in) :: nslvd ! number of "short lived" species 25 | integer, intent(in) :: indexm ! index for "m" 26 | integer, intent(in) :: indexh2o ! index for h2o 27 | integer, intent(in) :: spcno ! total number of xported species 28 | integer, intent(in) :: relcnt ! number of "relative" species 29 | integer, intent(in) :: grpcnt ! number of group species 30 | integer, intent(in) :: nzcnt(2) ! number of non-zero entries in lu 31 | integer, intent(in) :: clscnt(5) ! solution class count 32 | integer, intent(in) :: iter_counts(4) ! iteration counts 33 | integer, intent(in) :: cls_rxt_cnt(4,5) ! class reaction count 34 | 35 | real, intent(in) :: rxparm(2,*) ! rxtn rate parms 36 | logical, intent(in) :: radj_flag ! rxt adjust flag 37 | logical, intent(in) :: vec_ftns ! vector function flag 38 | logical, intent(in) :: chemistry ! chemistry flag 39 | 40 | character(len=16), intent(in) :: machine ! target machine 41 | integer, intent(in) :: veclen ! vector length in vectorized solver 42 | 43 | !----------------------------------------------------------------------- 44 | ! ... Local variables 45 | !----------------------------------------------------------------------- 46 | integer :: gascnt ! number of gas phase rxtns 47 | logical :: lexist 48 | 49 | inquire( file = 'chem.h', exist = lexist ) 50 | if( lexist ) then 51 | call system( 'rm chem.h' ) 52 | end if 53 | open( unit = 30, file = 'chem.h' ) 54 | 55 | write(30,'(''# define RXTTAGCNT '',i5)') rxt_tag_cnt 56 | write(30,'(''# define ENTHALPYCNT '',i5)') enthalpy_cnt 57 | write(30,'(''# define HETCNT '',i5)') hetcnt 58 | write(30,'(''# define EXTCNT '',i5)') usrcnt 59 | gascnt = sum( cls_rxt_cnt(1,1:5) ) 60 | write(30,'(''# define CLSINDPRD '',i5)') gascnt 61 | write(30,'(''# define CLSINDPRD1 '',i5)') cls_rxt_cnt(1,1) 62 | write(30,'(''# define CLSINDPRD2 '',i5)') cls_rxt_cnt(1,2) 63 | write(30,'(''# define CLSINDPRD3 '',i5)') cls_rxt_cnt(1,3) 64 | write(30,'(''# define CLSINDPRD4 '',i5)') cls_rxt_cnt(1,4) 65 | write(30,'(''# define CLSINDPRD5 '',i5)') cls_rxt_cnt(1,5) 66 | write(30,'(''# define IMP_NZCNT '',i5)') nzcnt(1) 67 | write(30,'(''# define ROD_NZCNT '',i5)') nzcnt(2) 68 | gascnt = cls_rxt_cnt(2,4) + cls_rxt_cnt(4,4) 69 | write(30,'(''# define IMP_LINCNT '',i5)') gascnt 70 | gascnt = cls_rxt_cnt(2,5) + cls_rxt_cnt(4,5) 71 | write(30,'(''# define ROD_LINCNT '',i5)') gascnt 72 | write(30,'(''# define IMP_NLNCNT '',i5)') cls_rxt_cnt(3,4) 73 | write(30,'(''# define ROD_NLNCNT '',i5)') cls_rxt_cnt(3,5) 74 | if( radj_flag ) then 75 | write(30,'(''# define RADJFLAG'')') 76 | end if 77 | write(30,'(''# define PHTCNT '',i5)') phtcnt 78 | write(30,'(''# define PHTCNTP1 '',i5)') phtcnt+1 79 | write(30,'(''# define RXNCNT '',i5)') rxntot 80 | gascnt = rxntot - phtcnt 81 | write(30,'(''# define GASCNT '',i5)') gascnt 82 | write(30,'(''# define SETRXNCNT '',i5)') rxpcnt 83 | write(30,'(''# define USRRXNCNT '',i5)') gascnt - rxpcnt 84 | gascnt = count( rxparm(2,1:rxpcnt) /= 0. ) 85 | write(30,'(''# define TDEPCNT '',i5)') gascnt 86 | write(30,'(''# define NCOL '',i5)') ncol 87 | write(30,'(''# define NFS '',i5)') nfs 88 | write(30,'(''# define NSLVD '',i5)') nslvd 89 | write(30,'(''# define VECLEN '',i5)') veclen 90 | write(30,'(''# define INDEXM '',i5)') indexm 91 | write(30,'(''# define INDEXH2O '',i5)') indexh2o 92 | write(30,'(''# define PCNST '',i5)') spcno 93 | write(30,'(''# define PCNSTP2 '',i5)') spcno+2 94 | write(30,'(''# define RELCNT '',i5)') relcnt 95 | write(30,'(''# define GRPCNT '',i5)') grpcnt 96 | write(30,'(''# define CLSCNT1 '',i5)') clscnt(1) 97 | write(30,'(''# define CLSCNT2 '',i5)') clscnt(2) 98 | write(30,'(''# define CLSCNT3 '',i5)') clscnt(3) 99 | write(30,'(''# define CLSCNT4 '',i5)') clscnt(4) 100 | write(30,'(''# define CLSCNT5 '',i5)') clscnt(5) 101 | write(30,'(''# define EBIITERMAX '',i5)') MAX( 1,iter_counts(4) ) 102 | write(30,'(''# define HOVITERMAX '',i5)') MAX( 1,iter_counts(1) ) 103 | write(30,'(''# define IMPITERMAX '',i5)') MAX( 1,iter_counts(2) ) 104 | write(30,'(''# define IMPJACITER '',i5)') MAX( 1,iter_counts(3) ) 105 | if( chemistry ) then 106 | write(30,'(''# define TROP_CHEM'')') 107 | end if 108 | close( 30 ) 109 | 110 | end subroutine chm_hdr 111 | -------------------------------------------------------------------------------- /src/cam_chempp/sol_cls.f: -------------------------------------------------------------------------------- 1 | 2 | subroutine SOL_CLS( iout ) 3 | !----------------------------------------------------------------------- 4 | ! ... Map solution species to solution method groups 5 | !----------------------------------------------------------------------- 6 | 7 | use IO 8 | use VAR_MOD, only : spccnt => new_nq, spcsym => new_solsym, clscnt, clsmap 9 | 10 | implicit none 11 | 12 | !----------------------------------------------------------------------- 13 | ! ... Dummy args 14 | !----------------------------------------------------------------------- 15 | character(len=80), intent(inout) :: iout(*) 16 | 17 | !----------------------------------------------------------------------- 18 | ! ... Local variables 19 | !----------------------------------------------------------------------- 20 | integer, parameter :: symlen = 16 21 | 22 | integer :: kpar, i, parsw(5), nchar 23 | integer :: toklen(20) 24 | integer :: j, l 25 | integer :: no_tokens 26 | integer :: class 27 | character(len=16) :: tokens(20) 28 | character(len=10) :: clshdr(5) = (/ 'EXPLICIT ', 'EBI ', & 29 | 'HOV ', 'IMPLICIT ', & 30 | 'RODAS ' /) 31 | character(len=11) :: clsend(5) = (/ 'ENDEXPLICIT', 'ENDEBI ', & 32 | 'ENDHOV ', 'ENDIMPLICIT', & 33 | 'ENDRODAS ' /) 34 | character(len=1) :: char 35 | logical :: found 36 | 37 | integer :: INILIST 38 | 39 | !----------------------------------------------------------------------- 40 | ! ... Initialization 41 | !----------------------------------------------------------------------- 42 | parsw(:) = 0 ; clscnt(:) = 0 ; clsmap(:,:,:) = 0 43 | 44 | call CARDIN( lin, buff, nchar ) 45 | buffh = buff 46 | call UPCASE( buffh ) 47 | if( buffh /= 'SOLUTIONCLASSES' ) then 48 | call ERRMES( '"Solution classes" card missing; run terminated@', & 49 | lout, char, 1, buff ) 50 | end if 51 | 52 | do 53 | call CARDIN(lin, buff, nchar ) 54 | buffh = buff 55 | call UPCASE( buffh ) 56 | if( buffh == 'ENDSOLUTIONCLASSES' ) then 57 | !----------------------------------------------------------------------- 58 | ! ... Check for all species in class 59 | !----------------------------------------------------------------------- 60 | if( sum( clscnt(:) ) /= spccnt ) then 61 | write(lout,*) ' ' 62 | write(lout,*) 'Following species not in a class' 63 | write(lout,*) ' ' 64 | do l = 1,spccnt 65 | found = .false. 66 | do class = 1,5 67 | if( clscnt(class) /= 0 ) then 68 | j = INILIST( l, clsmap(1,class,2), clscnt(class) ) 69 | if( j /= 0 ) then 70 | found = .true. 71 | exit 72 | end if 73 | end if 74 | end do 75 | if( .not. found ) then 76 | write(lout,*) trim(spcsym(l)) 77 | end if 78 | end do 79 | stop 'abort' 80 | end if 81 | exit 82 | end if 83 | 84 | found = .false. 85 | do kpar = 1,5 86 | if( buffh == clshdr(kpar) ) then 87 | found = .true. 88 | exit 89 | end if 90 | end do 91 | if( .not. found ) then 92 | call ERRMES( '# is an invalid class header@', & 93 | lout, & 94 | buff(:8), & 95 | 8, & 96 | buff ) 97 | else if( parsw(kpar) /= 0 ) then 98 | call ERRMES( '# solution class already declared@', & 99 | lout, & 100 | clshdr(kpar), & 101 | LEN_TRIM(clshdr(kpar)), & 102 | buff ) 103 | else 104 | parsw(kpar) = 1 105 | end if 106 | 107 | !----------------------------------------------------------------------- 108 | ! ... Read the solution class members 109 | !----------------------------------------------------------------------- 110 | Methods : & 111 | do 112 | call CARDIN(lin, buff, nchar) 113 | buffh = buff 114 | call UPCASE( buffh ) 115 | if( buffh /= clsend(kpar) ) then 116 | if( buffh(:nchar) == 'ALL' ) then 117 | clscnt(:5) = 0 118 | clscnt(kpar) = spccnt 119 | clsmap(:,:,:) = 0 120 | do j = 1,spccnt 121 | clsmap(j,kpar,1) = j 122 | clsmap(j,kpar,2) = j 123 | end do 124 | cycle 125 | else if( buffh(:nchar) == 'ALLOTHERS' ) then 126 | clscnt(kpar) = 0 127 | clsmap(:,kpar,:) = 0 128 | do j = 1,spccnt 129 | if( SUM( clsmap(j,:5,1) ) == 0 ) then 130 | clscnt(kpar) = clscnt(kpar) + 1 131 | clsmap(j,kpar,1) = clscnt(kpar) 132 | clsmap(clscnt(kpar),kpar,2) = j 133 | end if 134 | end do 135 | cycle 136 | end if 137 | call GETTOKENS( buff, & 138 | nchar, & 139 | ',', & 140 | symlen, & 141 | tokens, & 142 | toklen, & 143 | 20, & 144 | no_tokens ) 145 | if( no_tokens == 0 ) then 146 | call ERRMES( ' Species input line in error@', lout, buff, 1, ' ' ) 147 | end if 148 | 149 | Tok_loop: do j = 1,no_tokens 150 | do l = 1,spccnt 151 | if( trim(tokens(j)) == trim(spcsym(l)) ) then 152 | clscnt(kpar) = clscnt(kpar) + 1 153 | if( clscnt(kpar) > spccnt ) then 154 | call ERRMES( ' Species count exceeds limit@', & 155 | lout, & 156 | buff, 1, buff ) 157 | end if 158 | if( SUM( clsmap(l,:5,1) ) /= 0 ) then 159 | call ERRMES( ' # in two or more classes@', & 160 | lout, & 161 | tokens(j), & 162 | toklen(j), & 163 | buff ) 164 | end if 165 | clsmap(l,kpar,1) = clscnt(kpar) 166 | clsmap(clscnt(kpar),kpar,2) = l 167 | cycle tok_loop 168 | end if 169 | end do 170 | call ERRMES( ' Class member # not in solution list@', & 171 | lout, & 172 | tokens(j), & 173 | toklen(j), & 174 | buff ) 175 | end do Tok_loop 176 | else 177 | exit 178 | end if 179 | end do Methods 180 | end do 181 | 182 | end subroutine SOL_CLS 183 | -------------------------------------------------------------------------------- /src/cam_chempp/padj_code.f: -------------------------------------------------------------------------------- 1 | 2 | subroutine make_padj( fixmap, fixcnt, phtcnt, model, march ) 3 | !----------------------------------------------------------------------- 4 | ! ... Write the photorate adjustment code 5 | !----------------------------------------------------------------------- 6 | 7 | use var_mod, only : var_lim 8 | use io, only : temp_path 9 | 10 | implicit none 11 | 12 | !----------------------------------------------------------------------- 13 | ! ... The arguments 14 | !----------------------------------------------------------------------- 15 | integer, intent(in) :: fixcnt 16 | integer, intent(in) :: phtcnt 17 | integer, intent(in) :: fixmap(var_lim,2) 18 | character(len=*), intent(in) :: model 19 | character(len=*), intent(in) :: march 20 | 21 | !----------------------------------------------------------------------- 22 | ! ... The local variables 23 | !----------------------------------------------------------------------- 24 | integer :: k, rxno 25 | character(len=72) :: line 26 | logical :: first 27 | logical :: lexist 28 | 29 | 30 | inquire( file = trim( temp_path ) // 'mo_phtadj.F', exist = lexist ) 31 | if( lexist ) then 32 | call system( 'rm ' // trim( temp_path ) // 'mo_phtadj.F' ) 33 | end if 34 | open( unit = 30, file = trim( temp_path ) // 'mo_phtadj.F' ) 35 | 36 | line = ' ' 37 | write(30,100) trim(line) 38 | line(7:) = 'module mo_phtadj' 39 | write(30,100) trim(line) 40 | line = ' ' 41 | write(30,100) trim(line) 42 | line(7:) = 'private' 43 | write(30,100) trim(line) 44 | line(7:) = 'public :: phtadj' 45 | write(30,100) trim(line) 46 | line = ' ' 47 | write(30,100) trim(line) 48 | line(7:) = 'contains' 49 | write(30,100) trim(line) 50 | line = ' ' 51 | write(30,100) trim(line) 52 | select case( model ) 53 | case( 'MOZART' ) 54 | line(7:) = 'subroutine phtadj( p_rate, inv, m, plnplv )' 55 | case ( 'CAM' ) 56 | line(7:) = 'subroutine phtadj( p_rate, inv, m, ncol, nlev )' 57 | case ( 'WRF' ) 58 | line(7:) = 'subroutine phtadj( p_rate, inv, m, n )' 59 | end select 60 | write(30,100) trim(line) 61 | line = ' ' 62 | write(30,100) trim(line) 63 | if( model /= 'WRF' ) then 64 | line(7:) = 'use chem_mods, only : nfs, phtcnt' 65 | write(30,100) trim(line) 66 | end if 67 | if( model == 'CAM' ) then 68 | line(7:) = 'use shr_kind_mod, only : r8 => shr_kind_r8' 69 | write(30,100) trim(line) 70 | end if 71 | line = ' ' 72 | write(30,100) trim(line) 73 | line(7:) = 'implicit none' 74 | write(30,100) trim(line) 75 | line = ' ' 76 | write(30,100) trim(line) 77 | line = '!--------------------------------------------------------------------' 78 | write(30,100) trim(line) 79 | line = '! ... dummy arguments' 80 | write(30,100) trim(line) 81 | line = '!--------------------------------------------------------------------' 82 | write(30,100) trim(line) 83 | select case( model ) 84 | case( 'MOZART' ) 85 | line = ' integer, intent(in) :: plnplv' 86 | case ( 'CAM' ) 87 | line = ' integer, intent(in) :: ncol, nlev' 88 | case ( 'WRF' ) 89 | line = ' integer, intent(in) :: n' 90 | end select 91 | write(30,100) trim(line) 92 | select case( model ) 93 | case( 'MOZART' ) 94 | line = ' real, intent(in) :: inv(plnplv,nfs)' 95 | write(30,100) trim(line) 96 | line = ' real, intent(in) :: m(plnplv)' 97 | write(30,100) trim(line) 98 | line = ' real, intent(inout) :: p_rate(plnplv,phtcnt)' 99 | case( 'CAM' ) 100 | line = ' real(r8), intent(in) :: inv(ncol,nlev,max(1,nfs))' 101 | write(30,100) trim(line) 102 | line = ' real(r8), intent(in) :: m(ncol,nlev)' 103 | write(30,100) trim(line) 104 | line = ' real(r8), intent(inout) :: p_rate(ncol,nlev,max(1,phtcnt))' 105 | case( 'WRF' ) 106 | line = ' real, intent(in) :: inv(:,:)' 107 | write(30,100) trim(line) 108 | line = ' real, intent(in) :: m(:)' 109 | write(30,100) trim(line) 110 | line = ' real, intent(inout) :: p_rate(:,:)' 111 | end select 112 | write(30,100) trim(line) 113 | line = ' ' 114 | write(30,100) trim(line) 115 | line = '!--------------------------------------------------------------------' 116 | write(30,100) trim(line) 117 | line = '! ... local variables' 118 | write(30,100) trim(line) 119 | line = '!--------------------------------------------------------------------' 120 | write(30,100) trim(line) 121 | select case( model ) 122 | case( 'MOZART' ) 123 | line = ' real :: im(plnplv)' 124 | case( 'CAM' ) 125 | line = ' integer :: k' 126 | write(30,100) trim(line) 127 | line = ' real(r8) :: im(ncol,nlev)' 128 | case( 'WRF' ) 129 | line = ' real :: im(n)' 130 | end select 131 | write(30,100) trim(line) 132 | line = ' ' 133 | write(30,100) trim(line) 134 | 135 | if( model == 'CAM' ) then 136 | line = ' do k = 1,nlev' 137 | write(30,100) trim(line) 138 | end if 139 | 140 | first = .true. 141 | do k = 1,fixcnt 142 | rxno = abs( fixmap(k,1) ) 143 | if( fixmap(k,1) < 0 .and. rxno <= phtcnt ) then 144 | if( first ) then 145 | select case( model ) 146 | case( 'CAM' ) 147 | line(7:) = ' im(:ncol,k) = 1._r8 / m(:ncol,k)' 148 | case default 149 | line(7:) = 'im(:) = 1. / m(:)' 150 | end select 151 | write(30,100) trim(line) 152 | line = ' ' 153 | first = .false. 154 | end if 155 | select case( model ) 156 | case( 'CAM' ) 157 | write(line(7:),'('' p_rate(:,k,'',i3,'') = p_rate(:,k,'',i3,'')'')') rxno,rxno 158 | line(len_trim(line)+2:) = ' * inv(:,k,' 159 | write(line(len_trim(line)+1:),'(i2)') fixmap(k,2) 160 | line(len_trim(line)+1:) = ') * im(:,k)' 161 | case default 162 | line(7:) = 'p_rate(:, ) = p_rate(:, )' 163 | write(line(16:18),'(i3)') rxno 164 | write(line(32:34),'(i3)') rxno 165 | line(len_trim(line)+2:) = ' * inv(:,' 166 | write(line(len_trim(line)+1:),'(i2)') fixmap(k,2) 167 | line(len_trim(line)+1:) = ') * im(:)' 168 | end select 169 | write(30,100) trim(line) 170 | end if 171 | end do 172 | 173 | if( model == 'CAM') then 174 | line = ' end do' 175 | write(30,100) trim(line) 176 | end if 177 | 178 | line = ' ' 179 | write(30,100) trim(line) 180 | line(7:) = 'end subroutine phtadj' 181 | write(30,100) trim(line) 182 | line = ' ' 183 | write(30,100) trim(line) 184 | line(7:) = 'end module mo_phtadj' 185 | write(30,100) trim(line) 186 | 187 | close(30) 188 | 189 | 100 format(a) 190 | 191 | end subroutine make_padj 192 | -------------------------------------------------------------------------------- /src/cam_chempp/rmod_code.f: -------------------------------------------------------------------------------- 1 | 2 | subroutine make_rmod( rxt2rel_pntr, rel_rxt_map, rxt2grp_pntr, & 3 | grp_rxt_map, hetmap, hetcnt, rxntot, model, march ) 4 | !----------------------------------------------------------------------- 5 | ! ... Make the group ratios reaction rate adjustment code 6 | !----------------------------------------------------------------------- 7 | 8 | use rxt_mod, only : rxt_lim 9 | use io, only : temp_path 10 | 11 | implicit none 12 | 13 | !----------------------------------------------------------------------- 14 | ! ... Dummy args 15 | !----------------------------------------------------------------------- 16 | integer, intent(in) :: rxt2rel_pntr(rxt_lim,2) 17 | integer, intent(in) :: rel_rxt_map(rxt_lim,3,2) 18 | integer, intent(in) :: rxt2grp_pntr(rxt_lim,2) 19 | integer, intent(in) :: grp_rxt_map(rxt_lim,3,2) 20 | integer, intent(in) :: hetmap(rxt_lim) 21 | integer, intent(in) :: rxntot 22 | integer, intent(in) :: hetcnt 23 | character(len=*), intent(in) :: model 24 | character(len=*), intent(in) :: march 25 | 26 | !----------------------------------------------------------------------- 27 | ! ... Local variables 28 | !----------------------------------------------------------------------- 29 | integer, parameter :: max_len = 90 30 | integer :: k, l, rxno, row, index 31 | character(len=max_len) :: line 32 | logical :: first 33 | logical :: found 34 | logical :: lexist 35 | 36 | integer :: strlen 37 | 38 | inquire( file = trim( temp_path ) // 'mo_rxtmod.F', exist = lexist ) 39 | if( lexist ) then 40 | call system( 'rm ' // trim( temp_path ) // 'mo_rxt_mod.F' ) 41 | end if 42 | open( unit = 30, file = trim( temp_path ) // 'mo_rxt_mod.F' ) 43 | 44 | line = ' ' 45 | write(30,100) trim(line) 46 | line(7:) = 'module mo_rxt_mod' 47 | write(30,100) trim(line) 48 | line = ' ' 49 | write(30,100) trim(line) 50 | line(7:) = 'private' 51 | write(30,100) trim(line) 52 | line(7:) = 'public :: rxt_mod' 53 | write(30,100) trim(line) 54 | line = ' ' 55 | write(30,100) trim(line) 56 | line(7:) = 'contains' 57 | write(30,100) trim(line) 58 | line = ' ' 59 | write(30,100) trim(line) 60 | select case( model ) 61 | case( 'MOZART' ) 62 | line(7:) = 'subroutine rxt_mod( rate, het_rates, grp_ratios, plnplv )' 63 | case( 'CAM' ) 64 | line(7:) = 'subroutine rxt_mod( rate, het_rates, grp_ratios, chnkpnts )' 65 | case( 'WRF' ) 66 | line(7:) = 'subroutine rxt_mod( rate, grp_ratios )' 67 | end select 68 | write(30,100) trim(line) 69 | line = ' ' 70 | write(30,100) trim( line ) 71 | if( model /= 'WRF' ) then 72 | line(7:) = 'use chem_mods, only : rxntot, hetcnt, grpcnt' 73 | write(30,100) trim( line ) 74 | end if 75 | if( model == 'CAM' ) then 76 | line(7:) = 'use shr_kind_mod, only : r8 => shr_kind_r8' 77 | write(30,100) trim( line ) 78 | end if 79 | line = ' ' 80 | write(30,100) trim( line ) 81 | line(7:) = 'implicit none ' 82 | write(30,100) trim( line ) 83 | line = ' ' 84 | write(30,100) trim( line ) 85 | line = '!---------------------------------------------------------------------------' 86 | write(30,100) trim(line) 87 | line = '! ... dummy arguments' 88 | write(30,100) trim(line) 89 | line = '!---------------------------------------------------------------------------' 90 | write(30,100) trim(line) 91 | if( model == 'CAM' .and. march == 'VECTOR' ) then 92 | line = ' integer, intent(in) :: chnkpnts' 93 | write(30,100) trim(line) 94 | else if( model /= 'WRF' ) then 95 | line = ' integer, intent(in) :: plnplv' 96 | write(30,100) trim(line) 97 | end if 98 | if( model == 'MOZART' ) then 99 | line = ' real, intent(inout) :: rate(plnplv,rxntot)' 100 | write(30,100) trim(line) 101 | line = ' real, intent(inout) :: het_rates(plnplv,hetcnt)' 102 | write(30,100) trim(line) 103 | line = ' real, intent(in) :: grp_ratios(plnplv,grpcnt)' 104 | else if( model == 'CAM' ) then 105 | if( march /= 'VECTOR' ) then 106 | line = ' real(r8), intent(inout) :: rate(:,:)' 107 | write(30,100) trim(line) 108 | line = ' real(r8), intent(inout) :: het_rates(:,:)' 109 | write(30,100) trim(line) 110 | line = ' real(r8), intent(in) :: grp_ratios(:,:)' 111 | else 112 | line = ' real(r8), intent(inout) :: rate(chnkpnts,max(1,rxntot))' 113 | write(30,100) trim(line) 114 | line = ' real(r8), intent(inout) :: het_rates(chnkpnts,max(1,hetcnt))' 115 | write(30,100) trim(line) 116 | line = ' real(r8), intent(in) :: grp_ratios(chnkpnts,max(1,grpcnt))' 117 | end if 118 | else if( model == 'WRF' ) then 119 | line = ' real, intent(in) :: grp_ratios(:,:)' 120 | write(30,100) trim(line) 121 | line = ' real, intent(inout) :: rate(:,:)' 122 | end if 123 | write(30,100) trim(line) 124 | line = ' ' 125 | write(30,100) trim(line) 126 | 127 | first = .true. 128 | do k = 1,rxntot 129 | !----------------------------------------------------------------------- 130 | ! ... Scan the group map 131 | !----------------------------------------------------------------------- 132 | found = .false. 133 | index = rxt2grp_pntr(k,1) 134 | row = rxt2grp_pntr(k,2) 135 | do l = 1,index 136 | found = .true. 137 | if( first ) then 138 | line = ' ' 139 | first = .false. 140 | end if 141 | rxno = grp_rxt_map(row,1,index) 142 | if( l == 1 ) then 143 | line = ' ' 144 | line(7:) = 'rate(:, ) = rate(:, )' 145 | write(line(14:16),'(i3)') rxno 146 | write(line(28:30),'(i3)') rxno 147 | line(strlen(line)+2:) = ' * grp_ratios(:,' 148 | write(line(strlen(line)+1:),'(i2)') grp_rxt_map(row,l+1,index) 149 | line(strlen(line)+1:) = ')' 150 | else 151 | line(len_trim(line)+1:) = ' &' 152 | write(30,100) trim(line) 153 | line(6:) = ' ' 154 | line(33:) = ' * grp_ratios(:,' 155 | write(line(strlen(line)+1:),'(i2)') grp_rxt_map(row,l+1,index) 156 | line(strlen(line)+1:) = ')' 157 | end if 158 | end do 159 | if( found ) then 160 | write(30,100) trim(line) 161 | end if 162 | end do 163 | 164 | do k = 1,hetcnt 165 | if( hetmap(k) /= 0 ) then 166 | line = ' ' 167 | if( first ) then 168 | first = .false. 169 | end if 170 | line(7:) = ' het_rates(j, ) = het_rates(j, )' 171 | write(line(19:21),'(i3)') k 172 | write(line(38:40),'(i3)') k 173 | line(strlen(line)+2:) = ' * grp_ratios(:,' 174 | write(line(strlen(line)+1:),'(i2)') hetmap(k) 175 | line(strlen(line)+1:) = ')' 176 | write(30,100) trim(line) 177 | end if 178 | end do 179 | 180 | line = ' ' 181 | write(30,100) trim(line) 182 | line = ' end subroutine rxt_mod' 183 | write(30,100) trim(line) 184 | line = ' ' 185 | write(30,100) trim(line) 186 | line(7:) = 'end module mo_rxt_mod' 187 | write(30,100) trim(line) 188 | 189 | close(30) 190 | 191 | 100 format(a) 192 | 193 | end subroutine make_rmod 194 | -------------------------------------------------------------------------------- /src/cam_chempp/rate_tab.f: -------------------------------------------------------------------------------- 1 | 2 | subroutine MAKE_RATE_TAB( rxparm, & 3 | rxptab, & 4 | rxpcnt ) 5 | !----------------------------------------------------------------------- 6 | ! ... Make the code to setup the rate table 7 | !----------------------------------------------------------------------- 8 | 9 | use IO, only : temp_path 10 | 11 | implicit none 12 | 13 | !----------------------------------------------------------------------- 14 | ! ... Dummy arguments 15 | !----------------------------------------------------------------------- 16 | integer, intent(in) :: rxpcnt 17 | integer, intent(in) :: rxptab(*) 18 | 19 | real, intent(in) :: rxparm(2,*) 20 | 21 | !----------------------------------------------------------------------- 22 | ! ... Local variables 23 | !----------------------------------------------------------------------- 24 | integer :: i, j, k, cnt, pos 25 | character(len=72) :: line 26 | logical :: lexist 27 | 28 | if( rxpcnt == 0 ) then 29 | return 30 | else 31 | !----------------------------------------------------------------------- 32 | ! ... Check for temp dependent rates 33 | !----------------------------------------------------------------------- 34 | cnt = COUNT( rxparm(2,1:rxpcnt) /= 0. ) 35 | if( cnt == 0 ) then 36 | return 37 | end if 38 | end if 39 | 40 | !----------------------------------------------------------------------- 41 | ! ... First write the table setup routine 42 | !----------------------------------------------------------------------- 43 | INQUIRE( file = TRIM( temp_path ) // 'rxttab.F', exist = lexist ) 44 | if( lexist ) then 45 | call SYSTEM( 'rm ' // TRIM( temp_path ) // 'rxttab.F' ) 46 | end if 47 | OPEN( unit = 30, file = TRIM( temp_path ) // 'rxttab.F' ) 48 | 49 | line = ' ' 50 | write(30,100) line 51 | line(7:) = 'subroutine RXTTAB( )' 52 | write(30,100) line 53 | line = ' ' 54 | write(30,100) line 55 | line(7:) = 'implicit none ' 56 | write(30,100) line 57 | line = ' ' 58 | write(30,100) line 59 | line(7:) = 'real rates' 60 | write(30,100) line 61 | line(7:) = 'common / RXTTAB / rates(126,' 62 | write(line(LEN_TRIM(line)+1:),'(i3,'')'')') cnt 63 | write(30,100) line 64 | line = ' ' 65 | write(30,100) line 66 | line(7:) = 'real temp(126)' 67 | write(30,100) line 68 | line = ' ' 69 | write(30,100) line 70 | line(7:) = 'integer j' 71 | write(30,100) line 72 | line = ' ' 73 | write(30,100) line 74 | line = '# if defined(EXPHF)' 75 | write(30,100) line 76 | line = ' ' 77 | line(7:) = 'real EXPHF' 78 | write(30,100) line 79 | line = 'CDIR$ VFUNCTION EXPHF' 80 | write(30,100) line 81 | line = '# endif' 82 | write(30,100) line 83 | line = ' ' 84 | write(30,100) line 85 | 86 | line(7:) = 'do j = 1,126' 87 | write(30,100) line 88 | line = ' ' 89 | line(10:) = 'temp(j) = 1. / (180. + REAL(j-1))' 90 | write(30,100) line 91 | line = ' ' 92 | line(7:) = 'end do' 93 | write(30,100) line 94 | line = ' ' 95 | write(30,100) line 96 | line(7:) = 'do j = 1,126' 97 | write(30,100) line 98 | line = ' ' 99 | line(10:) = 'rates(j, ) =' 100 | k = 0 101 | do i = 1,rxpcnt 102 | if( rxparm(2,i) /= 0.e0 ) then 103 | k = k + 1 104 | write(line(18:20),'(i3)') k 105 | call R2C( line(25:), rxparm(1,i), 'l' ) 106 | pos = LEN_TRIM(line) 107 | write(30,*) '# if defined(EXPHF)' 108 | line(pos+1:) = '*EXPHF(' 109 | call R2C( line(LEN_TRIM(line)+1:), rxparm(2,i), 'l' ) 110 | line(LEN_TRIM(line)+1:) = ' * temp(j) )' 111 | write(30,100) line 112 | write(30,*) '# else' 113 | line(pos+1:) = '*EXP(' 114 | call R2C( line(LEN_TRIM(line)+1:), rxparm(2,i), 'l' ) 115 | line(LEN_TRIM(line)+1:) = ' * temp(j) )' 116 | write(30,100) line 117 | write(30,*) '# endif' 118 | end if 119 | end do 120 | 121 | line = ' ' 122 | line(7:) = 'end do' 123 | write(30,100) line 124 | line = ' ' 125 | write(30,100) line 126 | line(7:) = 'end' 127 | write(30,100) line 128 | 129 | CLOSE(30) 130 | !----------------------------------------------------------------------- 131 | ! ... Finally write the table interpolation routine 132 | !----------------------------------------------------------------------- 133 | INQUIRE( file = 'setrxt.F', exist = lexist ) 134 | if( lexist ) then 135 | call SYSTEM( 'rm setrxt.F' ) 136 | end if 137 | OPEN( unit = 30, file = 'setrxt.F' ) 138 | 139 | line = ' ' 140 | write(30,100) line 141 | line(7:) = 'subroutine SETRXT( rate,' 142 | write(30,100) line 143 | line(6:) = '$ temp )' 144 | write(30,100) line 145 | line = ' ' 146 | write(30,100) line 147 | line(7:) = 'implicit none ' 148 | write(30,100) line 149 | line = ' ' 150 | write(30,100) line 151 | line(7:) = 'real rate(PLNPLV,RXNCNT)' 152 | write(30,100) line 153 | line(7:) = 'real temp(PLNPLV)' 154 | write(30,100) line 155 | line = ' ' 156 | write(30,100) line 157 | line(7:) = 'real rates' 158 | write(30,100) line 159 | line(7:) = 'common / RXTTAB / rates(126,' 160 | write(line(LEN_TRIM(line)+1:),'(i3,'')'')') cnt 161 | write(30,100) line 162 | line = ' ' 163 | write(30,100) line 164 | line(7:) = 'integer i, ip1, j' 165 | write(30,100) line 166 | line(7:) = 'real del_temp' 167 | write(30,100) line 168 | line = ' ' 169 | write(30,100) line 170 | line(7:) = 'do j = 1,PLNPLV' 171 | write(30,100) line 172 | 173 | if( cnt /= rxpcnt ) then 174 | line = ' ' 175 | line(10:) = 'rate(j, ) =' 176 | do i = 1,rxpcnt 177 | if( rxparm(2,i) == 0.e0 ) then 178 | write(line(17:19),'(i3)') rxptab(i) 179 | call R2C( line(24:), rxparm(1,i), 'l' ) 180 | write(30,100) line 181 | end if 182 | end do 183 | end if 184 | line = ' ' 185 | line(7:) = 'end do' 186 | write(30,100) line 187 | line = ' ' 188 | write(30,100) line 189 | line(7:) = 'do j = 1,PLNPLV' 190 | write(30,100) line 191 | line = ' ' 192 | line(10:) = 'i = INT( temp(j) ) - 179' 193 | write(30,100) line 194 | line(10:) = 'i = MAX( 1,MIN( 125,i) )' 195 | write(30,100) line 196 | line(10:) = 'ip1 = i + 1' 197 | write(30,100) line 198 | line(10:) = 'del_temp = temp(j) - AINT(temp(j))' 199 | write(30,100) line 200 | line = ' ' 201 | k = 0 202 | do i = 1,rxpcnt 203 | if( rxparm(2,i) /= 0.e0 ) then 204 | line = ' ' 205 | line(10:) = 'rate(j,' 206 | k = k + 1 207 | write(line(LEN_TRIM(line)+1:),'(i3,'') ='')') rxptab(i) 208 | line(LEN_TRIM(line)+2:) = 'rates(i,' 209 | write(line(LEN_TRIM(line)+1:),'(i3,'')'')') k 210 | write(30,100) line 211 | j = INDEX( line,'=' ) + 2 212 | line(6:) = '$' 213 | line(j:) = '+ del_temp * (rates(ip1,' 214 | write(line(LEN_TRIM(line)+1:),'(i3,'')'')') k 215 | line(LEN_TRIM(line)+2:) = '- rates(i,' 216 | write(line(LEN_TRIM(line)+1:),'(i3,''))'')') k 217 | write(30,100) line 218 | end if 219 | end do 220 | 221 | line = ' ' 222 | line(7:) = 'end do' 223 | write(30,100) line 224 | line = ' ' 225 | write(30,100) line 226 | line(7:) = 'end' 227 | write(30,100) line 228 | CLOSE(30) 229 | 230 | 100 format(a72) 231 | 232 | end subroutine MAKE_RATE_TAB 233 | -------------------------------------------------------------------------------- /src/cam_chempp/rxt_equations.f: -------------------------------------------------------------------------------- 1 | module rxt_equations_mod 2 | use VAR_MOD, only : var_lim 3 | use RXT_MOD, only : rxt_lim, prd_lim, prd_limp1 4 | use utils, only: get_index 5 | 6 | implicit none 7 | 8 | private 9 | 10 | public :: write_rxt_out_code 11 | 12 | contains 13 | 14 | subroutine write_rxt_out_code ( & 15 | rxmcnt, & 16 | rxmap, & 17 | fixmap, & 18 | solsym, & 19 | fixsym, & 20 | prdcnt, & 21 | prdmap, & 22 | rxntot, & 23 | phtcnt, & 24 | outfile ) 25 | 26 | use io, only : temp_path 27 | 28 | implicit none 29 | 30 | integer, intent(in) :: rxmcnt(2) 31 | integer, intent(in) :: rxmap(rxt_lim,prd_lim+3,2) 32 | integer, intent(in) :: fixmap(var_lim,3,2) 33 | character(len=16), intent(in) :: solsym(var_lim) 34 | character(len=16), intent(in) :: fixsym(var_lim) 35 | integer, intent(in) :: phtcnt 36 | integer, intent(in) :: prdcnt 37 | integer, intent(in) :: rxntot 38 | integer, intent(in) :: prdmap(var_lim,prd_limp1) 39 | character(len=*), intent(in) :: outfile 40 | 41 | integer, parameter :: unitno = 33 42 | character(len=128) :: line 43 | character(len=64) :: mod_name 44 | logical :: lexist 45 | integer :: pos 46 | 47 | inquire( file = trim( temp_path ) // outfile, exist = lexist ) 48 | if( lexist ) then 49 | call system( 'rm ' // trim( temp_path ) // trim(outfile) ) 50 | end if 51 | open( unit = unitno, file = trim( temp_path ) // trim(outfile) ) 52 | 53 | pos = index(trim(outfile),'.F') 54 | mod_name = outfile(1:pos-1) 55 | 56 | line = ' ' 57 | line(1:) = 'module '//trim(mod_name) 58 | write(unitno,100) trim(line) 59 | 60 | line = ' ' 61 | line(3:) = 'use shr_kind_mod, only : r8 => shr_kind_r8' 62 | write(unitno,100) trim(line) 63 | 64 | line = ' ' 65 | line(3:) = 'implicit none' 66 | write(unitno,100) trim(line) 67 | 68 | line = ' ' 69 | line(3:) = 'private' 70 | write(unitno,100) trim(line) 71 | 72 | line = ' ' 73 | line(3:) = 'public :: set_rates' 74 | write(unitno,100) trim(line) 75 | 76 | line = ' ' 77 | line(1:) = 'contains' 78 | write(unitno,100) trim(line) 79 | 80 | line = ' ' 81 | line(4:) = 'subroutine set_rates( rxt_rates, sol, ncol )' 82 | write(unitno,100) trim(line) 83 | 84 | line = ' ' 85 | line(7:) = 'real(r8), intent(inout) :: rxt_rates(:,:,:)' 86 | write(unitno,100) trim(line) 87 | line = ' ' 88 | line(7:) = 'real(r8), intent(in) :: sol(:,:,:)' 89 | write(unitno,100) trim(line) 90 | line = ' ' 91 | line(7:) = 'integer, intent(in) :: ncol' 92 | write(unitno,100) trim(line) 93 | 94 | call write_rxt_equations ( & 95 | rxmcnt, & 96 | rxmap, & 97 | fixmap, & 98 | solsym, & 99 | fixsym, & 100 | prdcnt, & 101 | prdmap, & 102 | rxntot, & 103 | phtcnt, & 104 | unitno ) 105 | 106 | line = ' ' 107 | line(3:) = 'end subroutine set_rates' 108 | write(unitno,100) trim(line) 109 | 110 | line = ' ' 111 | line(1:) = 'end module '//trim(mod_name) 112 | write(unitno,100) trim(line) 113 | 114 | close(unitno) 115 | 116 | 100 format(a) 117 | 118 | end subroutine write_rxt_out_code 119 | 120 | subroutine write_rxt_equations ( & 121 | rxmcnt, & 122 | rxmap, & 123 | fixmap, & 124 | solsym, & 125 | fixsym, & 126 | prdcnt, & 127 | prdmap, & 128 | rxntot, & 129 | phtcnt, unitno ) 130 | 131 | implicit none 132 | 133 | integer, intent(in) :: rxmcnt(2) 134 | integer, intent(in) :: rxmap(rxt_lim,prd_lim+3,2) 135 | integer, intent(in) :: fixmap(var_lim,3,2) 136 | character(len=16), intent(in) :: solsym(var_lim) 137 | character(len=16), intent(in) :: fixsym(var_lim) 138 | integer, intent(in) :: phtcnt 139 | integer, intent(in) :: prdcnt 140 | integer, intent(in) :: rxntot 141 | integer, intent(in) :: prdmap(var_lim,prd_limp1) 142 | integer, intent(in) :: unitno 143 | 144 | character(len=80) :: eq_piece 145 | character(len=80) :: doc_piece 146 | character(len=6) :: num 147 | character(len=120) :: eqline 148 | character(len=120) :: docline 149 | character(len=16) :: symbol 150 | 151 | character(len=120) :: equations(rxntot) 152 | character(len=120) :: docs(rxntot) 153 | 154 | integer :: i,j,l 155 | integer :: rxno 156 | logical :: debug = .false. 157 | 158 | equations(:) = ' ' 159 | docs(:) = ' ' 160 | 161 | ! this is for case where all reactants are invariants 162 | do i = 1,prdcnt 163 | 164 | rxno = prdmap(i,1) 165 | write( num, '(i6)' ) rxno 166 | docline = 'rate_const' 167 | !!$ eqline = 'rxt_rates(:ncol,:,'//trim(num)//') = rxt_rates(:ncol,:,'//trim(num)//')' 168 | 169 | call get_fixed_reactants( fixmap, var_lim, 3, phtcnt, rxno, fixsym, doc_piece ) 170 | 171 | docline = trim(docline)//trim(doc_piece) 172 | 173 | !!$ equations(rxno) = trim(eqline) 174 | docs(rxno) = trim(docline) 175 | 176 | enddo 177 | 178 | do i = 1,2 179 | do j = 1,rxmcnt(i) 180 | 181 | rxno = rxmap(j,1,i) 182 | 183 | write(num, '(i6)' ) rxno 184 | docline = 'rate_const' 185 | eqline = 'rxt_rates(:ncol,:,'//trim(num)//') = rxt_rates(:ncol,:,'//trim(num)//')' 186 | eq_piece = ' ' 187 | doc_piece = ' ' 188 | 189 | call get_fixed_reactants( fixmap, var_lim, 3, phtcnt, rxno, fixsym, doc_piece ) 190 | 191 | do l = 2,i+1 192 | if( rxmap(j,l,i) == 0 ) then 193 | exit 194 | end if 195 | symbol = solsym(ABS(rxmap(j,l,i))) 196 | 197 | write(num,'(i6)') ABS(rxmap(j,l,i)) 198 | eq_piece = trim(eq_piece)//'*sol(:ncol,:,' // trim(num) //')' 199 | doc_piece = trim(doc_piece)//'*' // trim(symbol) 200 | 201 | end do 202 | 203 | eqline = trim(eqline)//trim(eq_piece) 204 | docline = trim(docline)//trim(doc_piece) 205 | 206 | equations(rxno) = trim(eqline) 207 | docs(rxno) = trim(docline) 208 | 209 | enddo 210 | enddo 211 | 212 | do i = 1,rxntot 213 | write(unitno,'(a6,a120,a)') ' ',equations(i), ' ! '//trim(docs(i)) 214 | enddo 215 | 216 | if (debug) then 217 | write(*,*) ' EQUATIONS : ' 218 | do i = 1,rxntot 219 | write(*,'(i4,a120,a)') i, ' '//equations(i), ' ! '//trim(docs(i)) 220 | enddo 221 | endif 222 | 223 | end subroutine write_rxt_equations 224 | 225 | subroutine get_fixed_reactants( & 226 | fixmap, & 227 | rowdim, & 228 | coldim, & 229 | phtcnt, & 230 | rxno, & 231 | fixsym, & 232 | doc_piece ) 233 | 234 | use VAR_MOD, only : var_lim 235 | 236 | implicit none 237 | 238 | !----------------------------------------------------------------------- 239 | ! ... Dummy args 240 | !----------------------------------------------------------------------- 241 | integer, intent(in) :: rowdim, coldim, phtcnt 242 | integer, intent(in) :: fixmap(rowdim,coldim,2) 243 | integer, intent(in) :: rxno 244 | character(len=*), intent(in) :: fixsym(:) 245 | 246 | character(len=*), intent(out) :: doc_piece 247 | 248 | !----------------------------------------------------------------------- 249 | ! ... Local variables 250 | !----------------------------------------------------------------------- 251 | integer :: j, l, index 252 | character(len=16) :: symbol 253 | character(len=6) :: num 254 | 255 | integer :: irx 256 | 257 | doc_piece = ' ' 258 | 259 | irx = rxno 260 | if( rxno < phtcnt ) then 261 | irx = - rxno 262 | end if 263 | do j = 1,2 264 | index = get_index( fixmap(1,1,j), var_lim, 3, 1, irx ) 265 | if( index /= 0 ) then 266 | do l = 2,3 267 | 268 | if( fixmap(index,l,j) == 0 ) then 269 | return 270 | end if 271 | 272 | symbol = fixsym(fixmap(index,l,j)) 273 | write(num,'(i6)') fixmap(index,l,j) 274 | 275 | doc_piece = trim(doc_piece)//'*' // trim(symbol) 276 | 277 | end do 278 | exit 279 | end if 280 | end do 281 | 282 | end subroutine get_fixed_reactants 283 | 284 | end module rxt_equations_mod 285 | -------------------------------------------------------------------------------- /src/cam_chempp/outp.f: -------------------------------------------------------------------------------- 1 | 2 | subroutine OUTP( rxparms, & 3 | nr, & 4 | np, & 5 | rxtsym, & 6 | prdsym, & 7 | sym_rate, & 8 | irxn, & 9 | rate, & 10 | loc_rxt_alias, & 11 | lout ) 12 | 13 | use RXT_MOD, only : rxtnt_lim, prd_lim 14 | 15 | implicit none 16 | 17 | !----------------------------------------------------------------------- 18 | ! OUTP OUTPuts a single reaction and rate 19 | ! 20 | ! Inputs: 21 | ! nr - number of reactants 22 | ! np - number of products 23 | ! rxparms - vector of "full" product terms (including 24 | ! multipliers) 25 | ! rxtsym - reactant symbol(s) 26 | ! prdsym - product symbol(s) 27 | ! irxn - reaction number 28 | ! rate - vector of reaction rate parameters 29 | ! lout - logical OUTPut unit number 30 | ! Outputs: 31 | ! NONE 32 | !----------------------------------------------------------------------- 33 | 34 | integer, intent(in) :: nr, np, irxn, lout 35 | real, intent(in) :: rate(:) 36 | character(len=16), intent(in) :: rxparms(prd_lim) 37 | character(len=16), intent(in) :: sym_rate(5) 38 | character(len=16), intent(in) :: loc_rxt_alias 39 | character(len=16), intent(in) :: rxtsym(rxtnt_lim), prdsym(prd_lim) 40 | 41 | !----------------------------------------------------------------------- 42 | ! ... Local variables 43 | !----------------------------------------------------------------------- 44 | integer :: i, j, k, kl, length, retcod, line_cnt 45 | integer :: buff_pos, arrow_pos 46 | real :: coeff 47 | character(len=320) :: buff 48 | character(len=64) :: rx_piece 49 | 50 | buff = ' ' 51 | j = 1 52 | 53 | !----------------------------------------------------------------------- 54 | ! ... Form the reactants 55 | !----------------------------------------------------------------------- 56 | do i = 1,nr 57 | length = LEN_TRIM( rxtsym(i) ) 58 | buff(j:length+j-1) = rxtsym(i)(:length) 59 | j = length + j + 1 60 | if( i == nr ) then 61 | buff(j:) = '->' 62 | j = j + 3 63 | else 64 | buff(j:) = '+' 65 | j = j + 2 66 | end if 67 | end do 68 | buff_pos = j ; arrow_pos = j - 1 69 | 70 | !----------------------------------------------------------------------- 71 | ! ... Form the products 72 | !----------------------------------------------------------------------- 73 | line_cnt = 1 74 | if( np /= 0 ) then 75 | do i = 1,np 76 | rx_piece = ' ' 77 | j = 1 78 | length = INDEX( rxparms(i), '*' ) 79 | if( length /= 0 ) then 80 | read(rxparms(i)(:length-1),*,iostat=retcod) coeff 81 | if( retcod /= 0 ) then 82 | call ERRMES( ' # is not a valid real number@', & 83 | lout, & 84 | rxparms(i), & 85 | length-1, & 86 | buff ) 87 | end if 88 | if( coeff /= 1. ) then 89 | length = length + 1 90 | rx_piece(:length) = rxparms(i)(:length-1) // '*' 91 | j = length 92 | end if 93 | end if 94 | length = LEN_TRIM( prdsym(i) ) 95 | rx_piece(j:length+j-1) = prdsym(i)(:length) 96 | length = LEN_TRIM( rx_piece ) 97 | if( (buff_pos + length) <= 69 ) then 98 | buff(buff_pos:) = TRIM( rx_piece ) 99 | buff_pos = buff_pos + length + 1 100 | if( i /= np ) then 101 | buff(buff_pos:buff_pos) = '+' 102 | buff_pos = buff_pos + 2 103 | else 104 | kl = line_cnt 105 | do k = kl,3 106 | call WRITE_RXT( buff, sym_rate, rate, loc_rxt_alias, irxn, line_cnt ) 107 | line_cnt = line_cnt + 1 108 | end do 109 | end if 110 | else 111 | call WRITE_RXT( buff, sym_rate, rate, loc_rxt_alias, irxn, line_cnt ) 112 | line_cnt = line_cnt + 1 113 | if( i /= np ) then 114 | buff(arrow_pos:arrow_pos) = '+' 115 | buff_pos = arrow_pos + 2 116 | else 117 | kl = line_cnt 118 | do k = kl,3 119 | call WRITE_RXT( buff, sym_rate, rate, loc_rxt_alias, irxn, line_cnt ) 120 | line_cnt = line_cnt + 1 121 | end do 122 | end if 123 | end if 124 | end do 125 | else 126 | buff(j:) = '(No products)' 127 | do k = 1,3 128 | call WRITE_RXT( buff, sym_rate, rate, loc_rxt_alias, irxn, line_cnt ) 129 | line_cnt = line_cnt + 1 130 | end do 131 | end if 132 | 133 | end subroutine OUTP 134 | 135 | subroutine WRITE_RXT( buff, sym_rate, rate, loc_rxt_alias, irxn, line_cnt ) 136 | !----------------------------------------------------------------------- 137 | ! ... Print the reaction rate 138 | !----------------------------------------------------------------------- 139 | 140 | use IO, only : lout 141 | use RXT_MOD, only : phtcnt 142 | 143 | implicit none 144 | 145 | !----------------------------------------------------------------------- 146 | ! ... Dummy arguments 147 | !----------------------------------------------------------------------- 148 | integer, intent(in) :: line_cnt, irxn 149 | real, intent(in) :: rate(:) 150 | character(len=320), intent(inout) :: buff 151 | character(len=16), intent(in) :: sym_rate(:) 152 | character(len=16), intent(in) :: loc_rxt_alias 153 | 154 | !----------------------------------------------------------------------- 155 | ! ... Local variables 156 | !----------------------------------------------------------------------- 157 | logical :: troe_rate 158 | 159 | if( line_cnt <= 3 ) then 160 | if( sym_rate(1) /= ' ' ) then 161 | troe_rate = rate(1) /= 0. .and. rate(3) /= 0. 162 | if( line_cnt == 1 ) then 163 | if( rate(1) == 0. ) then 164 | buff(69:) = ' rate = 0.' 165 | write(lout,100) loc_rxt_alias, irxn, buff, irxn+phtcnt 166 | else if( .not. troe_rate ) then 167 | buff(69:) = ' rate = ' 168 | write(buff(77:),'(1pe8.2)') rate(1) 169 | if( rate(2) /= 0. ) then 170 | buff(85:) = '*EXP(' 171 | write(buff(90:),'(f8.0)') rate(2) 172 | buff(98:) = '/t)' 173 | end if 174 | write(lout,100) loc_rxt_alias, irxn, buff, irxn+phtcnt 175 | else 176 | buff(69:) = ' troe : ko=' 177 | write(buff(80:),'(1pe8.2)') rate(1) 178 | if( rate(2) /= 0. ) then 179 | buff(88:) = '*(300/t)**' 180 | write(buff(98:),'(f4.2)') rate(2) 181 | end if 182 | write(lout,110) loc_rxt_alias, irxn, buff, irxn+phtcnt 183 | end if 184 | else if( troe_rate ) then 185 | if( line_cnt == 2 ) then 186 | buff(69:) = ' ki=' 187 | write(buff(80:),'(1pe8.2)') rate(3) 188 | if( rate(4) /= 0. ) then 189 | if( rate(4) /= 1. ) then 190 | buff(88:) = '*(300/t)**' 191 | write(buff(98:),'(f4.2)') rate(4) 192 | else 193 | buff(88:) = '*(300/t)' 194 | end if 195 | end if 196 | else if( line_cnt == 3 ) then 197 | buff(69:) = ' f=' 198 | write(buff(80:),'(f4.2)') rate(5) 199 | end if 200 | write(lout,120) buff 201 | else if( buff /= ' ' ) then 202 | write(lout,120) buff 203 | end if 204 | else 205 | if( line_cnt == 1 ) then 206 | buff(69:) = ' rate = ** User defined **' 207 | write(lout,100) loc_rxt_alias, irxn, buff, irxn+phtcnt 208 | end if 209 | end if 210 | else if( buff /= ' ' ) then 211 | write(lout,120) buff 212 | end if 213 | buff = ' ' 214 | 215 | !----------------------------------------------------------------------- 216 | ! ... Formats 217 | !----------------------------------------------------------------------- 218 | 100 format(2x,a8,1x,'(',i3,')',3x,a100,3x,'(',i3,')') 219 | 110 format(2x,a8,1x,'(',i3,')',3x,a101,2x,'(',i3,')') 220 | 120 format(19x,a101) 221 | 222 | end subroutine WRITE_RXT 223 | -------------------------------------------------------------------------------- /src/cam_chempp/mak_grp_vmr.f: -------------------------------------------------------------------------------- 1 | 2 | subroutine mak_grp_vmr( grp_mem_cnt, mem2grp_map, model, march ) 3 | !------------------------------------------------------------------- 4 | ! ... Write the group volume mixing ratios code 5 | !------------------------------------------------------------------- 6 | 7 | use io, only : temp_path 8 | 9 | implicit none 10 | 11 | !------------------------------------------------------------------- 12 | ! ... Dummy args 13 | !------------------------------------------------------------------- 14 | integer, intent(in) :: grp_mem_cnt 15 | integer, intent(in) :: mem2grp_map(*) 16 | character(len=*), intent(in) :: model 17 | character(len=*), intent(in) :: march 18 | 19 | !------------------------------------------------------------------- 20 | ! ... Local variables 21 | !------------------------------------------------------------------- 22 | integer, parameter :: max_len= 90 23 | integer :: m 24 | character(len=max_len) :: line 25 | logical :: lexist 26 | 27 | inquire( file = trim( temp_path ) // 'mo_make_grp_vmr.F', exist = lexist ) 28 | if( lexist ) then 29 | call system( 'rm ' // trim( temp_path ) // 'mo_make_grp_vmr.F' ) 30 | end if 31 | open( unit = 30, file = trim( temp_path ) // 'mo_make_grp_vmr.F' ) 32 | 33 | line = ' ' 34 | write(30,100) trim(line) 35 | line(7:) = 'module mo_make_grp_vmr' 36 | write(30,100) trim(line) 37 | line = ' ' 38 | write(30,100) trim(line) 39 | line(7:) = 'private' 40 | write(30,100) trim(line) 41 | line(7:) = 'public :: mak_grp_vmr' 42 | write(30,100) trim(line) 43 | line = ' ' 44 | write(30,100) trim(line) 45 | line(7:) = 'contains' 46 | write(30,100) trim(line) 47 | line = ' ' 48 | write(30,100) trim(line) 49 | select case( model ) 50 | case( 'MOZART' ) 51 | line(7:) = 'subroutine mak_grp_vmr( vmr, group_ratios, group_vmrs, plonl )' 52 | case( 'CAM' ) 53 | if( march /= 'VECTOR' ) then 54 | line(7:) = 'subroutine mak_grp_vmr( vmr, group_ratios, group_vmrs, plonl )' 55 | else 56 | line(7:) = 'subroutine mak_grp_vmr( vmr, group_ratios, group_vmrs, chnkpnts )' 57 | end if 58 | case( 'WRF' ) 59 | line(7:) = 'subroutine mak_grp_vmr( vmr, group_ratios, group_vmrs )' 60 | end select 61 | write(30,100) trim(line) 62 | line = ' ' 63 | write(30,100) trim(line) 64 | if( model == 'MOZART' ) then 65 | line(7:) = 'use mo_grid, only : plev, pcnstm1' 66 | write(30,100) trim(line) 67 | line(7:) = 'use chem_mods, only : grpcnt' 68 | else if( model == 'CAM' ) then 69 | line(7:) = 'use chem_mods, only : grpcnt, gas_pcnst' 70 | write(30,100) trim(line) 71 | if( march /= 'VECTOR' ) then 72 | line(7:) = 'use ppgrid, only : pver' 73 | write(30,100) trim(line) 74 | end if 75 | line(7:) = 'use shr_kind_mod, only : r8 => shr_kind_r8' 76 | else if( model == 'WRF' ) then 77 | line(7:) = ' ' 78 | end if 79 | write(30,100) trim(line) 80 | line = ' ' 81 | write(30,100) trim(line) 82 | line(7:) = 'implicit none ' 83 | write(30,100) trim(line) 84 | line = ' ' 85 | write(30,100) trim(line) 86 | line = '!----------------------------------------------------------------------------' 87 | write(30,100) trim(line) 88 | line = '! ... dummy arguments' 89 | write(30,100) trim(line) 90 | line = '!----------------------------------------------------------------------------' 91 | write(30,100) trim(line) 92 | select case( model ) 93 | case( 'MOZART' ) 94 | line = ' integer, intent(in) :: plonl' 95 | write(30,100) trim(line) 96 | case( 'CAM' ) 97 | if( march /= 'VECTOR' ) then 98 | line = ' integer, intent(in) :: plonl' 99 | else 100 | line = ' integer, intent(in) :: chnkpnts' 101 | end if 102 | write(30,100) trim(line) 103 | end select 104 | if( model == 'MOZART' ) then 105 | line = ' real, intent(in) :: vmr(plonl,plev,pcnstm1)' 106 | write(30,100) trim(line) 107 | line = ' real, intent(in) :: group_ratios(plonl,plev,grpcnt)' 108 | write(30,100) trim(line) 109 | line = ' real, intent(out) :: group_vmrs(plonl,plev,grpcnt)' 110 | else if( model == 'CAM' ) then 111 | if( march /= 'VECTOR' ) then 112 | line = ' real(r8), intent(in) :: vmr(:,:,:)' 113 | write(30,100) trim(line) 114 | line = ' real(r8), intent(in) :: group_ratios(:,:,:)' 115 | write(30,100) trim(line) 116 | line = ' real(r8), intent(out) :: group_vmrs(:,:,:)' 117 | else 118 | line = ' real(r8), intent(in) :: vmr(chnkpnts,max(1,gas_pcnst))' 119 | write(30,100) trim(line) 120 | line = ' real(r8), intent(in) :: group_ratios(chnkpnts,max(1,grpcnt))' 121 | write(30,100) trim(line) 122 | line = ' real(r8), intent(out) :: group_vmrs(chnkpnts,max(1,grpcnt))' 123 | end if 124 | else if( model == 'WRF' ) then 125 | line = ' real, intent(in) :: vmr(:,:)' 126 | write(30,100) trim(line) 127 | line = ' real, intent(in) :: group_ratios(:,:)' 128 | write(30,100) trim(line) 129 | line = ' real, intent(out) :: group_vmrs(:,:)' 130 | end if 131 | write(30,100) trim(line) 132 | line = ' ' 133 | write(30,100) trim(line) 134 | if( model /= 'WRF' ) then 135 | line = '!----------------------------------------------------------------------------' 136 | write(30,100) trim(line) 137 | line = '! ... local variables' 138 | write(30,100) trim(line) 139 | line = '!----------------------------------------------------------------------------' 140 | write(30,100) trim(line) 141 | line = ' integer :: k' 142 | write(30,100) trim(line) 143 | end if 144 | if( grp_mem_cnt > 0 ) then 145 | line = ' ' 146 | write(30,100) trim(line) 147 | select case( model ) 148 | case( 'MOZART' ) 149 | line(7:) = 'do k = 1,plev' 150 | write(30,100) trim(line) 151 | case( 'CAM' ) 152 | if( march /= 'VECTOR' ) then 153 | line(7:) = 'do k = 1,plev' 154 | else 155 | line(7:) = 'do k = 1,chnkpnts' 156 | end if 157 | write(30,100) trim(line) 158 | end select 159 | do m = 1,grp_mem_cnt 160 | line = ' ' 161 | select case( model ) 162 | case( 'MOZART' ) 163 | line(10:) = 'group_vmrs(:,k, ) = group_ratios(:,k, )' 164 | write(line(25:26),'(i2)') m 165 | write(line(48:49),'(i2)') m 166 | line(len_trim(line)+1:) = ' * vmr(:,k,' 167 | case( 'CAM' ) 168 | if( march /= 'VECTOR' ) then 169 | line(10:) = 'group_vmrs(:,k, ) = group_ratios(:,k, )' 170 | write(line(25:26),'(i2)') m 171 | write(line(48:49),'(i2)') m 172 | line(len_trim(line)+1:) = ' * vmr(:,k,' 173 | else 174 | line(10:) = 'group_vmrs(k, ) = group_ratios(k, )' 175 | write(line(10:),'(''group_vmrs(k,'',i2,'') = group_ratios(k,'',i2,'')'')') m, m 176 | line(len_trim(line)+1:) = ' * vmr(:,k,' 177 | end if 178 | case( 'WRF' ) 179 | line(7:) = 'group_vmrs(:,' 180 | write(line(len_trim(line)+1:),*) m 181 | line(len_trim(line)+1:) = ') = group_ratios(:,' 182 | write(line(len_trim(line)+1:),*) m 183 | line(len_trim(line)+1:) = ') * vmr(:,' 184 | end select 185 | write(line(len_trim(line)+1:),'(i2,'')'')') mem2grp_map(m) 186 | write(30,100) trim(line) 187 | end do 188 | if( model /= 'WRF' ) then 189 | line = ' ' 190 | line(7:) = 'end do' 191 | write(30,100) trim(line) 192 | end if 193 | end if 194 | line = ' ' 195 | write(30,100) trim(line) 196 | line(7:) = 'end subroutine mak_grp_vmr' 197 | write(30,100) trim(line) 198 | line = ' ' 199 | write(30,100) trim(line) 200 | line(7:) = 'end module mo_make_grp_vmr' 201 | write(30,100) trim(line) 202 | 203 | 100 format(a) 204 | 205 | end subroutine mak_grp_vmr 206 | --------------------------------------------------------------------------------