Ignore:
Timestamp:
Sep 10, 2019 6:04:34 PM (5 years ago)
Author:
gronemeier
Message:

implement new palm_date_time_mod; replaced namelist parameters time_utc_init and day_of_year_init by origin_date_time

File:
1 edited

Legend:

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

    r4218 r4227  
    2727! -----------------
    2828! $Id$
     29! implement new palm_date_time_mod
     30!
     31! 4223 2019-09-10 09:20:47Z gronemeier
    2932! Unused routine chem_emissions_check_parameters commented out due to uninitialized content
    3033!
     
    118121        ONLY: chem_emis_att_type, chem_emis_val_type
    119122
    120     USE date_and_time_mod,                                                   &
    121         ONLY: day_of_month, hour_of_day,                                     &
    122              index_mm, index_dd, index_hh,                                   &
    123              month_of_year, hour_of_day,                                     &
    124              time_default_indices, time_preprocessed_indices
    125    
    126123    USE chem_gasphase_mod,                                                   &
    127124        ONLY: nvar, spc_names
     
    905902! Description:
    906903! ------------
    907 !> Routine for Update of Emission values at each timestep
     904!> Routine for Update of Emission values at each timestep.
     905!>
     906!> @todo Clarify the correct usage of index_dd, index_hh and index_mm. Consider
     907!>       renaming of these variables.
     908!> @todo Clarify time used in emis_lod=2 mode. ATM, the used time seems strange.
    908909!-------------------------------------------------------------------------------!
    909910
     
    919920       ONLY: hyp, pt
    920921
     922    USE control_parameters, &
     923        ONLY: time_since_reference_point
     924
     925    USE palm_date_time_mod, &
     926        ONLY: days_per_week, get_date_time, hours_per_day, months_per_year, seconds_per_day
    921927   
    922928 IMPLICIT NONE
     
    940946    INTEGER(iwp) ::  m                                                          !< running index for horizontal surfaces
    941947
     948    INTEGER(iwp) ::  day_of_month                                               !< day of the month
     949    INTEGER(iwp) ::  day_of_week                                                !< day of the week
     950    INTEGER(iwp) ::  day_of_year                                                !< day of the year
     951    INTEGER(iwp) ::  days_since_reference_point                                 !< days since reference point
     952    INTEGER(iwp) ::  hour_of_day                                                !< hour of the day
     953    INTEGER(iwp) ::  month_of_year                                              !< month of the year
     954    INTEGER(iwp) ::  index_dd                                                   !< index day
     955    INTEGER(iwp) ::  index_hh                                                   !< index hour
     956    INTEGER(iwp) ::  index_mm                                                   !< index month
     957
     958    REAL(wp) ::  time_utc_init                                                  !< second of day of initial date
     959
    942960    !
    943961    !-- CONVERSION FACTORS: TIME 
    944962    REAL(wp), PARAMETER ::  hour_per_year =  8760.0_wp  !< number of hours in a year of 365 days 
    945     REAL(wp), PARAMETER ::  hour_per_day  =    24.0_wp  !< number of hours in a day
    946963    REAL(wp), PARAMETER ::  s_per_hour    =  3600.0_wp  !< number of sec per hour (s)/(hour)   
    947964    REAL(wp), PARAMETER ::  s_per_day     = 86400.0_wp  !< number of sec per day (s)/(day) 
     
    10731090!-- Update time indices
    10741091
    1075           CALL time_preprocessed_indices( index_hh )
    1076 
     1092          CALL get_date_time( 0.0_wp, second_of_day=time_utc_init )
     1093          CALL get_date_time( time_since_reference_point, hour=hour_of_day )
     1094
     1095          days_since_reference_point = INT( FLOOR( ( time_utc_init + time_since_reference_point ) &
     1096                                                   / seconds_per_day ) )
     1097
     1098          index_hh = days_since_reference_point * hours_per_day + hour_of_day
    10771099
    10781100!
     
    11021124!-- Update time indices
    11031125
    1104              CALL time_default_indices( month_of_year, day_of_month, hour_of_day, index_hh )
     1126             CALL get_date_time( time_since_reference_point, &
     1127                                 day_of_year=day_of_year, hour=hour_of_day )
     1128             index_hh = ( day_of_year - 1_iwp ) * hour_of_day
    11051129
    11061130!
     
    11321156!
    11331157!-- Update time indices
    1134              CALL time_default_indices( daytype_mdh, month_of_year, day_of_month,  &
    1135                   hour_of_day, index_mm, index_dd,index_hh )
    1136 
     1158             CALL get_date_time( time_since_reference_point, &
     1159                                 month=month_of_year,        &
     1160                                 day=day_of_month,           &
     1161                                 hour=hour_of_day,           &
     1162                                 day_of_week=day_of_week     )
     1163             index_mm = month_of_year
     1164             index_dd = months_per_year + day_of_week
     1165             SELECT CASE(TRIM(daytype_mdh))
     1166
     1167                CASE ("workday")
     1168                   index_hh = months_per_year + days_per_week + hour_of_day
     1169
     1170                CASE ("weekend")
     1171                   index_hh = months_per_year + days_per_week + hours_per_day + hour_of_day
     1172
     1173                CASE ("holiday")
     1174                   index_hh = months_per_year + days_per_week + 2*hours_per_day + hour_of_day
     1175
     1176             END SELECT
    11371177!
    11381178!-- Check if the index is less or equal to the temporal dimension of MDH emission files
     
    11891229
    11901230!
    1191 !-- Get time-factor for specific hour
     1231!--       Get time-factor for specific hour
     1232          CALL get_date_time( time_since_reference_point, hour=hour_of_day )
    11921233
    11931234          index_hh = hour_of_day
     
    11961237       ENDIF  ! emiss_lod
    11971238
    1198        
     1239
    11991240!
    12001241!--  Emission distribution calculation
     
    12571298                                                 time_factor(icat) *           &
    12581299                                                 emt_att%nox_comp(icat,1) *    &
    1259                                                  conversion_factor * hour_per_day
     1300                                                 conversion_factor * hours_per_day
    12601301
    12611302                   emis_distribution(1,nys:nyn,nxl:nxr,ispec) =                &
     
    12701311                                                 time_factor(icat) *           &
    12711312                                                 emt_att%nox_comp(icat,2) *    &
    1272                                                  conversion_factor * hour_per_day
     1313                                                 conversion_factor * hours_per_day
    12731314
    12741315                   emis_distribution(1,nys:nyn,nxl:nxr,ispec) =                &
     
    12831324                                                 time_factor(icat) *           &
    12841325                                                 emt_att%sox_comp(icat,1) *    &
    1285                                                  conversion_factor * hour_per_day
     1326                                                 conversion_factor * hours_per_day
    12861327
    12871328                   emis_distribution(1,nys:nyn,nxl:nxr,ispec) =                &
     
    12981339                                                 time_factor(icat) *           &
    12991340                                                 emt_att%sox_comp(icat,2) *    &
    1300                                                  conversion_factor * hour_per_day
     1341                                                 conversion_factor * hours_per_day
    13011342
    13021343                   emis_distribution(1,nys:nyn,nxl:nxr,ispec) =                &
     
    13151356                                                    time_factor(icat) *                  &
    13161357                                                    emt_att%pm_comp(icat,i_pm_comp,1) *  &
    1317                                                     conversion_factor * hour_per_day
     1358                                                    conversion_factor * hours_per_day
    13181359
    13191360                      emis_distribution(1,nys:nyn,nxl:nxr,ispec) =                       &
     
    13331374                                                    time_factor(icat) *                  &
    13341375                                                    emt_att%pm_comp(icat,i_pm_comp,2) *  &
    1335                                                     conversion_factor * hour_per_day
     1376                                                    conversion_factor * hours_per_day
    13361377
    13371378                      emis_distribution(1,nys:nyn,nxl:nxr,ispec) =                       &
     
    13511392                                                    time_factor(icat)     *              &
    13521393                                                    emt_att%pm_comp(icat,i_pm_comp,3) *  &
    1353                                                     conversion_factor * hour_per_day
     1394                                                    conversion_factor * hours_per_day
    13541395
    13551396                      emis_distribution(1,nys:nyn,nxl:nxr,ispec) =                       &
     
    13721413                                                       time_factor(icat) *               &
    13731414                                                       emt_att%voc_comp(icat,match_spec_voc_input(ivoc)) *   &
    1374                                                        conversion_factor * hour_per_day
     1415                                                       conversion_factor * hours_per_day
    13751416
    13761417                         emis_distribution(1,nys:nyn,nxl:nxr,ispec) =                    &
     
    13891430                   delta_emis(nys:nyn,nxl:nxr) = emis(nys:nyn,nxl:nxr) *                 &
    13901431                                                 time_factor(icat) *                     &
    1391                                                  conversion_factor * hour_per_day
     1432                                                 conversion_factor * hours_per_day
    13921433 
    13931434                   emis_distribution(1,nys:nyn,nxl:nxr,ispec) =                          &
Note: See TracChangeset for help on using the changeset viewer.