Changeset 3783 for palm


Ignore:
Timestamp:
Mar 5, 2019 1:23:50 PM (5 years ago)
Author:
forkel
Message:

Removed forgotten write statements an some of the unused variables

File:
1 edited

Legend:

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

    r3780 r3783  
    2727! -----------------
    2828! $Id$
     29! Removed forgotte write statements an some unused variables (did not touch the
     30! parts related to deposition)
     31!
     32!
     33! 3780 2019-03-05 11:19:45Z forkel
    2934! Removed READ from unit 10, added CALL get_mechanismname
    3035!
     
    731736               bc_radiation_s               
    732737    USE indices,                                                               & 
    733         ONLY:  nxl, nxr,  nxlg, nxrg, nyng, nysg, nzt                             
     738        ONLY:  nxl, nxr, nzt                             
    734739
    735740    USE arrays_3d,                                                             &     
     
    747752    INTEGER(iwp) ::  m                            !< running index surface elements.
    748753    INTEGER(iwp) ::  lsp                          !< running index for chem spcs.
    749     INTEGER(iwp) ::  lph                          !< running index for photolysis frequencies
    750754
    751755
     
    869873 SUBROUTINE chem_boundary_conds_decycle( cs_3d, cs_pr_init )
    870874
    871     USE pegrid,                                                             &
    872         ONLY:  myid
    873 
    874875    IMPLICIT NONE
    875876    INTEGER(iwp) ::  boundary  !<
     
    10271028 SUBROUTINE chem_check_data_output( var, unit, i, ilen, k )
    10281029
    1029 
    1030     USE control_parameters,                                                 &
    1031         ONLY:  data_output, message_string
    10321030
    10331031    IMPLICIT NONE
     
    11861184!-- check for chemical mechanism used
    11871185    CALL get_mechanismname
    1188     WRITE(06,*) 'cs_mech ',cs_mech
    1189     WRITE(06,*) 'chem_mechanism ', chem_mechanism
    11901186    IF (chem_mechanism /= trim(cs_mech) )  THEN
    11911187       message_string = 'Incorrect chemistry mechanism selected, check spelling in namelist and/or chem_gasphase_mod'
     
    12571253    USE kinds
    12581254
    1259     USE pegrid,                                                               &
    1260         ONLY:  myid, threads_per_task
    1261 
    12621255    IMPLICIT NONE
    12631256
     
    12801273    INTEGER(iwp) ::  j               !< grid index along y-direction
    12811274    INTEGER(iwp) ::  k               !< grid index along z-direction
    1282     INTEGER(iwp) ::  m               !< running index surface elements
    12831275    INTEGER(iwp) ::  char_len        !< length of a character string
    12841276    found = .FALSE.
     
    14601452    USE indices
    14611453    USE kinds
    1462     USE pegrid,                                                                       &
    1463         ONLY:  myid, threads_per_task
    14641454    USE surface_mod,                                                                  &
    14651455        ONLY:  get_topography_top_index_ji
     
    17931783 SUBROUTINE chem_init_internal
    17941784
    1795     USE control_parameters,                                                    &
    1796         ONLY:  message_string, io_blocks, io_group, turbulent_inflow
    1797     USE arrays_3d,                                                             &
    1798         ONLY:  mean_inflow_profiles
    17991785    USE pegrid
    18001786
     
    20632049    INTEGER(iwp) ::  lsp                                                     !< running index for chem spcs.
    20642050    INTEGER(iwp) ::  lph                                                     !< running index for photolysis frequencies
    2065     INTEGER      ::  k
    2066     INTEGER      ::  m
    2067     INTEGER      ::  istatf
    20682051    INTEGER, DIMENSION(20)    :: istatus
    20692052    REAL(kind=wp), DIMENSION(nzb+1:nzt,nspec)                :: tmp_conc
     
    20832066!    REAL(wp), PARAMETER              ::  xm_air  = 28.96_wp                  !< Mole mass of dry air
    20842067!    REAL(wp), PARAMETER              ::  xm_h2o  = 18.01528_wp               !< Mole mass of water vapor
    2085     REAL(wp), PARAMETER              ::  pref_i  = 1._wp / 100000.0_wp       !< inverse reference pressure (1/Pa)
    20862068    REAL(wp), PARAMETER              ::  t_std   = 273.15_wp                 !< standard pressure (Pa)
    20872069    REAL(wp), PARAMETER              ::  p_std   = 101325.0_wp               !< standard pressure (Pa)
     
    21822164
    21832165    CHARACTER (LEN=80) ::  line                        !< dummy string that contains the current line of the parameter file
    2184     CHARACTER (LEN=3)  ::  cs_prefix
    21852166
    21862167    REAL(wp), DIMENSION(nmaxfixsteps) ::   my_steps    !< List of fixed timesteps   my_step(1) = 0.0 automatic stepping
    21872168    INTEGER(iwp) ::  i                                 !<
    2188     INTEGER(iwp) ::  j                                 !<
    21892169    INTEGER(iwp) ::  max_pr_cs_tmp                     !<
    21902170
     
    22422222    !--   Read chem namelist   
    22432223
    2244     INTEGER             :: ier
    2245     CHARACTER(LEN=64)   :: text
    22462224    CHARACTER(LEN=8)    :: solver_type
    22472225
     
    26772655    INTEGER(iwp) ::  sr   !< statistical region
    26782656    INTEGER(iwp) ::  tn   !< thread number
    2679     INTEGER(iwp) ::  n    !<
    2680     INTEGER(iwp) ::  m    !<
    26812657    INTEGER(iwp) ::  lpr  !< running index chem spcs
    26822658
Note: See TracChangeset for help on using the changeset viewer.