Changeset 3652 for palm


Ignore:
Timestamp:
Jan 7, 2019 3:29:59 PM (5 years ago)
Author:
forkel
Message:

Checks added for chemistry mechanism, parameter chem_mechanism added

Location:
palm/trunk/SOURCE
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/chem_modules.f90

    r3636 r3652  
    2727! -----------------
    2828! $Id$
     29! parameter chem_mechanism added (basit)
     30!
     31!
     32! 3636 2018-12-19 13:48:34Z raasch
    2933! nopointer option removed
    3034!
     
    133137    CHARACTER (LEN=80)                ::  time_fac_type       ='MDH'                !< Type of time treatment in the emis DEFAULT mode: HOUR .OR. MDH
    134138    CHARACTER (LEN=80)                ::  daytype_mdh         ='workday'            !< Type of day in the MDH case: workday, weekend, holiday
    135     CHARACTER (LEN=11), DIMENSION(99) ::  data_output_pr_cs   = 'novalue'           !< Namelist parameter: Names of the che    m for profile output
     139    CHARACTER (LEN=11), DIMENSION(99) ::  data_output_pr_cs   = 'novalue'           !< Namelist parameter: Names of the chem species for profile output
    136140                                                                                    !< by cs_name for each height lvls defined by cs_heights
     141    CHARACTER (LEN=30)                ::  chem_mechanism      = 'phstatp'           !< Namelist parameter: Name of chemistry mechanism
     142                                                                                    !< (must match with third line in chem_gasphase_mod.f90)
    137143!
    138144!-- Namelist parameters for chem_emissions
  • palm/trunk/SOURCE/chemistry_model_mod.f90

    r3646 r3652  
    2727! -----------------
    2828! $Id$
     29! Checks added for chemistry mechanism, parameter chem_mechanism added (basit)
     30!
     31!
     32! 3646 2018-12-28 17:58:49Z kanani
    2933! Bugfix: use time_since_reference_point instead of simulated_time (relevant
    3034! when using wall/soil spinup)
     
    11201124    INTEGER (iwp) ::  lsp_usr      !< running index for user defined chem spcs
    11211125    INTEGER (iwp) ::  lsp          !< running index for chem spcs.
    1122 
     1126    CHARACTER (LEN=30)       ::  cs_mech,a1,b1,string
     1127
     1128
     1129    OPEN (10,FILE="chem_gasphase_mod.f90")   !get the chem_mechanism name from the file.
     1130    READ (10, 100) a1,b1,string
     1131    cs_mech = trim(string(16:))
     1132 100    FORMAT(a)
     1133        CLOSE(10)
    11231134
    11241135!
     
    11531164       CALL message( 'chem_check_parameters', 'CM0426', 1, 2, 0, 6, 0 )
    11541165    ENDIF
     1166!-- check for chemical mechanism used
     1167    IF (chem_mechanism /= trim(cs_mech) )  THEN
     1168       message_string = 'Incorrect chemical mechanism selected, please check spelling and/or chem_gasphase_mod'
     1169       CALL message( 'chem_check_parameters', 'CM0462', 1, 2, 0, 6, 0 )
     1170    ENDIF
     1171
    11551172
    11561173!---------------------
    11571174!-- chem_check_parameters is called before the array chem_species is allocated!
    11581175!-- temporary switch of this part of the check
    1159     RETURN
     1176!    RETURN                !bK commented
    11601177!---------------------
    11611178
     
    11731190       IF ( .not. found ) THEN
    11741191          message_string = 'Unused/incorrect input for initial surface value: ' // TRIM(cs_name(lsp_usr))
    1175           CALL message( 'chem_check_parameters', 'CM0427', 0, 1, 0, 6, 0 )
     1192          CALL message( 'chem_check_parameters', 'CM0427', 1, 2, 0, 6, 0 )
    11761193       ENDIF
    11771194       lsp_usr = lsp_usr + 1
     
    11931210          message_string = 'Unused/incorrect input of chemical species for surface emission fluxes: '  &
    11941211                            // TRIM(surface_csflux_name(lsp_usr))
    1195           CALL message( 'chem_check_parameters', 'CM0428', 0, 1, 0, 6, 0 )
     1212          CALL message( 'chem_check_parameters', 'CM0428', 1, 2, 0, 6, 0 )
    11961213       ENDIF
    11971214       lsp_usr = lsp_usr + 1
     
    15901607    CHARACTER (LEN=80)       :: docsflux_chr
    15911608    CHARACTER (LEN=80)       :: docsinit_chr
    1592 
    1593 !
     1609    CHARACTER (LEN=30)       ::  cs_mech,a1,b1,string
     1610
     1611!
     1612    OPEN (10,FILE="chem_gasphase_mod.f90")   !get the chem_mechanism name from the file.
     1613    READ (10, 100) a1,b1,string
     1614    cs_mech = trim(string(16:))
     1615100 FORMAT(a)   
     1616    CLOSE(10)
     1617
    15941618!-- Write chemistry model  header
    15951619    WRITE( io, 1 )
     
    16581682!-- number of variable and fix chemical species and number of reactions
    16591683    cs_fixed = nspec - nvar
     1684
     1685    WRITE ( io, * ) '   --> Chemical Mechanism        : ', cs_mech
    16601686    WRITE ( io, * ) '   --> Chemical species, variable: ', nvar
    16611687    WRITE ( io, * ) '   --> Chemical species, fixed   : ', cs_fixed
     
    19601986    REAL(wp), PARAMETER              ::  t_std   = 273.15_wp                 !< standard pressure (Pa)
    19611987    REAL(wp), PARAMETER              ::  p_std   = 101325.0_wp               !< standard pressure (Pa)
    1962     REAL(wp), PARAMETER              ::  vmolcm  = 22.414e3_wp               !< Mole volume (22.414 l) in cm^{-3}
     1988    REAL(wp), PARAMETER              ::  vmolcm  = 22.414e3_wp               !< Mole volume (22.414 l) in cm^3
    19631989    REAL(wp), PARAMETER              ::  xna     = 6.022e23_wp               !< Avogadro number (molecules/mol)
    19641990
     
    20762102         chem_debug2,                      &
    20772103         chem_gasphase_on,                 &
     2104         chem_mechanism,                   &         
    20782105         cs_heights,                       &
    20792106         cs_name,                          &
     
    25602587    INTEGER(iwp) ::  m    !<
    25612588    INTEGER(iwp) ::  lpr  !< running index chem spcs
     2589    LOGICAL      ::  ts_calc = .TRUE.
     2590
    25622591    !    REAL(wp),                                                                                      &
    25632592    !    DIMENSION(dots_num_palm+1:dots_max) ::                                                         &
     
    25892618          ENDDO
    25902619       ENDDO
    2591     ELSEIF ( mode == 'time_series' )  THEN
     2620    ELSEIF ( mode == 'time_series' .and. ts_calc )  THEN
    25922621       CALL location_message( 'Time series not calculated for chemistry', .TRUE. )
     2622       ts_calc = .FALSE.
    25932623    ENDIF
    25942624
Note: See TracChangeset for help on using the changeset viewer.