chem/module_add_emis_cptec.F

   1 Module module_add_emis_cptec
   2 CONTAINS
   3        subroutine add_emis_cptec(id,dtstep,ktau,dz8w,config_flags,      &
   4             curr_secs,rho_phy,chem,                                     &
   5             julday,gmt,xlat,xlong,t_phy,p_phy,emis_ant,                 &
   6 !         ebu_no,ebu_co,ebu_co2,ebu_eth,ebu_hc3,ebu_hc5,ebu_hc8,          &
   7 !          ebu_ete,ebu_olt,ebu_oli,ebu_pm25,ebu_pm10,ebu_dien,ebu_iso,     &
   8 !          ebu_api,ebu_lim,ebu_tol,ebu_xyl,ebu_csl,ebu_hcho,ebu_ald,       &
   9 !          ebu_ket,ebu_macr,ebu_ora1,ebu_ora2,                          &
  10             ids,ide, jds,jde, kds,kde,                                  &
  11             ims,ime, jms,jme, kms,kme,                                  &
  12             its,ite, jts,jte, kts,kte                                   )
  13   USE module_configure
  14   USE module_state_description
  15   USE module_date_time
  16
  17   IMPLICIT NONE
  18
  19
  20    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
  21
  22    INTEGER,      INTENT(IN   ) :: id,julday,                               &
  23                                   ids,ide, jds,jde, kds,kde,               &
  24                                   ims,ime, jms,jme, kms,kme,               &
  25                                   its,ite, jts,jte, kts,kte
  26    INTEGER,      INTENT(IN   ) ::                                          &
  27                                   ktau
  28    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ),                 &
  29          INTENT(INOUT ) ::                                   chem
  30    REAL, DIMENSION( ims:ime, kms:config_flags%kemit, jms:jme,num_emis_ant ),            &
  31          INTENT(IN ) ::                                                    &
  32                                          emis_ant
  33 !
  34 !
  35 !
  36    REAL,  DIMENSION( ims:ime ,  jms:jme )         ,               &
  37           INTENT(IN   ) ::                                                 &
  38                                                       xlat,xlong
  39    REAL,  DIMENSION( ims:ime , kms:kme , jms:jme )         ,               &
  40           INTENT(IN   ) ::                                                 &
  41                                                       t_phy,               &
  42                                                       p_phy,               &
  43                                                       dz8w,                &
  44                                                     rho_phy
  45 !  REAL,  DIMENSION( ims:ime , kms:kme , jms:jme )         ,               &
  46 !         INTENT(IN   ) ::                                                 &
  47 !         ebu_no,ebu_co,ebu_co2,ebu_eth,ebu_hc3,ebu_hc5,ebu_hc8,          &
  48 !          ebu_ete,ebu_olt,ebu_oli,ebu_pm25,ebu_pm10,ebu_dien,ebu_iso,     &
  49 !          ebu_api,ebu_lim,ebu_tol,ebu_xyl,ebu_csl,ebu_hcho,ebu_ald,       &
  50 !          ebu_ket,ebu_macr,ebu_ora1,ebu_ora2
  51
  52       REAL,      INTENT(IN   ) ::                                          &
  53                              dtstep,gmt
  54
  55       REAL(KIND=8), INTENT(IN   ) :: curr_secs
  56
  57     integer ::imonth1,idate1,iyear1,itime1
  58     integer :: i,j,k
  59     real :: time,conv_rho
  60     integer :: iweek,idays
  61     real :: tign,timeq,r_q,r_antro
  62     real, dimension(7) :: week_CYCLE
  63     integer :: century_year,month,day,hour,minute,second,ten_thousandth
  64
  65     !                     dia da semana:  DOM   SEG   TER   QUA   QUI   SEX   SAB
  66     !                            iweek=   1     2     3     4     5     6     7
  67     !- dados cetesb/campinas/2005
  68     data (week_CYCLE(iweek),iweek=1,7) /0.67, 1.1, 1.1, 1.1, 1.1, 1.1, 0.83/ !total = 7
  69     real, parameter :: bx_bburn  = 18.041288 * 3600., & !- peak at 18 UTC
  70                   cx        =  2.184936 * 3600., &
  71                   rinti     =  2.1813936e-8    , &
  72                   ax        = 2000.6038        , &
  73                   bx_antro  = 15.041288 * 3600.    !- peak em 15 UTC
  74     !itime1 : initial time of simulation (hour*100)
  75     ! time  : time elapsed in seconds
  76     ! r_q : gaussian function in 1/sec
  77
  78     !-------------biomass burning diurnal cycle --------------------
  79     !number of days of simulation
  80     call split_date_char(start_date,century_year,month,day,hour,minute, &
  81          second,ten_thousandth)
  82     itime1 = hour
  83
  84     idays = int(( float(itime1) + time/3600.)/24.+.00001)
  85     tign  = real(idays)*24.*3600.
  86     ! Modulacao da queimada media durante o ciclo diurno(unidade: 1/s)
  87     ! com a int( r_q dt) (0 - 24h)= 1.
  88     timeq= ( time + float(itime1)*3600. - tign )
  89     timeq=mod(timeq,86400.)
  90
  91
  92     !------------- anthropogenic diurnal cycle (industrial,residencial, ...)
  93     ! weekly cycle
  94     ! week day
  95     iweek= int(((float(julday)/7. - &
  96            int(julday/7))*7.)) + 1
  97     if(iweek.gt.7) iweek = iweek-7
  98     !- diurnal cycle
  99     r_antro  =1.4041297e-05*(exp(-((timeq-bx_antro)**2)/(43200.**2))+0.1)
 100     !- weekly + diurnal cycle
 101     r_antro = 86400.*r_antro * week_CYCLE(iweek)
 102
 103       do 100 j=jts,jte
 104       do 100 i=its,ite
 105
 106       k=kts
 107 !
 108 !  r_antro makes it weird!!!
 109 !
 110         conv_rho=r_antro*4.828e-4/rho_phy(i,k,j)*dtstep/(60.*dz8w(i,k,j))
 111 !       if(i.eq.its.and.j.eq.jts)then
 112 !         write(0,*)conv_rho,r_antro,rho_phy(i,k,j),dtstep,dz8w(i,k,j),emis_ant(i,k,j,p_e_co)
 113 !       endif
 114         chem(i,k,j,p_csl)  =  chem(i,k,j,p_csl)                        &
 115                          +emis_ant(i,k,j,p_e_csl)*conv_rho
 116         chem(i,k,j,p_iso)  = chem(i,k,j,p_iso)                         &
 117                          +emis_ant(i,k,j,p_e_iso)*conv_rho
 118         chem(i,k,j,p_so2)  = chem(i,k,j,p_so2)                         &
 119                          +emis_ant(i,k,j,p_e_so2)*conv_rho
 120         chem(i,k,j,p_no)   = chem(i,k,j,p_no)                          &
 121                          +emis_ant(i,k,j,p_e_no)*conv_rho
 122         chem(i,k,j,p_ald)  = chem(i,k,j,p_ald)                         &
 123                          +emis_ant(i,k,j,p_e_ald)*conv_rho
 124         chem(i,k,j,p_hcho) = chem(i,k,j,p_hcho)                        &
 125                          +emis_ant(i,k,j,p_e_hcho)*conv_rho
 126         chem(i,k,j,p_ora2)  = chem(i,k,j,p_ora2)                       &
 127                          +emis_ant(i,k,j,p_e_ora2)*conv_rho
 128         chem(i,k,j,p_nh3)  = chem(i,k,j,p_nh3)                         &
 129                          +emis_ant(i,k,j,p_e_nh3)*conv_rho
 130         chem(i,k,j,p_hc3)  = chem(i,k,j,p_hc3)                         &
 131                          +emis_ant(i,k,j,p_e_hc3)*conv_rho
 132         chem(i,k,j,p_hc5)  = chem(i,k,j,p_hc5)                         &
 133                          +emis_ant(i,k,j,p_e_hc5)*conv_rho
 134         chem(i,k,j,p_hc8)  = chem(i,k,j,p_hc8)                         &
 135                          +emis_ant(i,k,j,p_e_hc8)*conv_rho
 136         chem(i,k,j,p_eth)  = chem(i,k,j,p_eth)                         &
 137                          +emis_ant(i,k,j,p_e_eth)*conv_rho
 138         chem(i,k,j,p_co)  = chem(i,k,j,p_co)                           &
 139                          +emis_ant(i,k,j,p_e_co)*conv_rho
 140         if(p_ol2.gt.1)chem(i,k,j,p_ol2)  = chem(i,k,j,p_ol2)           &
 141                          +emis_ant(i,k,j,p_e_ol2)*conv_rho
 142         if(p_ete.gt.1)chem(i,k,j,p_ete)  = chem(i,k,j,p_ete)           &
 143                          +emis_ant(i,k,j,p_e_ol2)*conv_rho
 144         chem(i,k,j,p_olt)  = chem(i,k,j,p_olt)                         &
 145                          +emis_ant(i,k,j,p_e_olt)*conv_rho
 146         chem(i,k,j,p_oli)  = chem(i,k,j,p_oli)                         &
 147                          +emis_ant(i,k,j,p_e_oli)*conv_rho
 148         chem(i,k,j,p_tol)  = chem(i,k,j,p_tol)                         &
 149                          +emis_ant(i,k,j,p_e_tol)*conv_rho
 150         chem(i,k,j,p_xyl)  = chem(i,k,j,p_xyl)                         &
 151                          +emis_ant(i,k,j,p_e_xyl)*conv_rho
 152         chem(i,k,j,p_ket)  =  chem(i,k,j,p_ket)                        &
 153                          +emis_ant(i,k,j,p_e_ket)*conv_rho
 154         chem(i,k,j,p_pm_25)  =  chem(i,k,j,p_pm_25)                        &
 155                          +r_antro*emis_ant(i,k,j,p_e_pm_25)/rho_phy(i,k,j)/dz8w(i,k,j)*dtstep
 156         chem(i,k,j,p_pm_10)  =  chem(i,k,j,p_pm_10)                        &
 157                          +r_antro*emis_ant(i,k,j,p_e_pm_10)/rho_phy(i,k,j)/dz8w(i,k,j)*dtstep
 158  100  continue
 159
 160
 161     END subroutine add_emis_cptec
 162
 163 END Module module_add_emis_cptec