Module module_add_emis_cptec CONTAINS subroutine add_emis_cptec(id,dtstep,ktau,dz8w,config_flags, & curr_secs,rho_phy,chem, & julday,gmt,xlat,xlong,t_phy,p_phy,emis_ant, & ! ebu_no,ebu_co,ebu_co2,ebu_eth,ebu_hc3,ebu_hc5,ebu_hc8, & ! ebu_ete,ebu_olt,ebu_oli,ebu_pm25,ebu_pm10,ebu_dien,ebu_iso, & ! ebu_api,ebu_lim,ebu_tol,ebu_xyl,ebu_csl,ebu_hcho,ebu_ald, & ! ebu_ket,ebu_macr,ebu_ora1,ebu_ora2, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ) USE module_configure USE module_state_description USE module_date_time IMPLICIT NONE TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags INTEGER, INTENT(IN ) :: id,julday, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte INTEGER, INTENT(IN ) :: & ktau REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), & INTENT(INOUT ) :: chem REAL, DIMENSION( ims:ime, kms:config_flags%kemit, jms:jme,num_emis_ant ), & INTENT(IN ) :: & emis_ant ! ! ! REAL, DIMENSION( ims:ime , jms:jme ) , & INTENT(IN ) :: & xlat,xlong REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , & INTENT(IN ) :: & t_phy, & p_phy, & dz8w, & rho_phy ! REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , & ! INTENT(IN ) :: & ! ebu_no,ebu_co,ebu_co2,ebu_eth,ebu_hc3,ebu_hc5,ebu_hc8, & ! ebu_ete,ebu_olt,ebu_oli,ebu_pm25,ebu_pm10,ebu_dien,ebu_iso, & ! ebu_api,ebu_lim,ebu_tol,ebu_xyl,ebu_csl,ebu_hcho,ebu_ald, & ! ebu_ket,ebu_macr,ebu_ora1,ebu_ora2 REAL, INTENT(IN ) :: & dtstep,gmt REAL(KIND=8), INTENT(IN ) :: curr_secs integer ::imonth1,idate1,iyear1,itime1 integer :: i,j,k real :: time,conv_rho integer :: iweek,idays real :: tign,timeq,r_q,r_antro real, dimension(7) :: week_CYCLE integer :: century_year,month,day,hour,minute,second,ten_thousandth ! dia da semana: DOM SEG TER QUA QUI SEX SAB ! iweek= 1 2 3 4 5 6 7 !- dados cetesb/campinas/2005 data (week_CYCLE(iweek),iweek=1,7) /0.67, 1.1, 1.1, 1.1, 1.1, 1.1, 0.83/ !total = 7 real, parameter :: bx_bburn = 18.041288 * 3600., & !- peak at 18 UTC cx = 2.184936 * 3600., & rinti = 2.1813936e-8 , & ax = 2000.6038 , & bx_antro = 15.041288 * 3600. !- peak em 15 UTC !itime1 : initial time of simulation (hour*100) ! time : time elapsed in seconds ! r_q : gaussian function in 1/sec !-------------biomass burning diurnal cycle -------------------- !number of days of simulation call split_date_char(start_date,century_year,month,day,hour,minute, & second,ten_thousandth) itime1 = hour idays = int(( float(itime1) + time/3600.)/24.+.00001) tign = real(idays)*24.*3600. ! Modulacao da queimada media durante o ciclo diurno(unidade: 1/s) ! com a int( r_q dt) (0 - 24h)= 1. timeq= ( time + float(itime1)*3600. - tign ) timeq=mod(timeq,86400.) !------------- anthropogenic diurnal cycle (industrial,residencial, ...) ! weekly cycle ! week day iweek= int(((float(julday)/7. - & int(julday/7))*7.)) + 1 if(iweek.gt.7) iweek = iweek-7 !- diurnal cycle r_antro =1.4041297e-05*(exp(-((timeq-bx_antro)**2)/(43200.**2))+0.1) !- weekly + diurnal cycle r_antro = 86400.*r_antro * week_CYCLE(iweek) do 100 j=jts,jte do 100 i=its,ite k=kts ! ! r_antro makes it weird!!! ! conv_rho=r_antro*4.828e-4/rho_phy(i,k,j)*dtstep/(60.*dz8w(i,k,j)) ! if(i.eq.its.and.j.eq.jts)then ! write(0,*)conv_rho,r_antro,rho_phy(i,k,j),dtstep,dz8w(i,k,j),emis_ant(i,k,j,p_e_co) ! endif chem(i,k,j,p_csl) = chem(i,k,j,p_csl) & +emis_ant(i,k,j,p_e_csl)*conv_rho chem(i,k,j,p_iso) = chem(i,k,j,p_iso) & +emis_ant(i,k,j,p_e_iso)*conv_rho chem(i,k,j,p_so2) = chem(i,k,j,p_so2) & +emis_ant(i,k,j,p_e_so2)*conv_rho chem(i,k,j,p_no) = chem(i,k,j,p_no) & +emis_ant(i,k,j,p_e_no)*conv_rho chem(i,k,j,p_ald) = chem(i,k,j,p_ald) & +emis_ant(i,k,j,p_e_ald)*conv_rho chem(i,k,j,p_hcho) = chem(i,k,j,p_hcho) & +emis_ant(i,k,j,p_e_hcho)*conv_rho chem(i,k,j,p_ora2) = chem(i,k,j,p_ora2) & +emis_ant(i,k,j,p_e_ora2)*conv_rho chem(i,k,j,p_nh3) = chem(i,k,j,p_nh3) & +emis_ant(i,k,j,p_e_nh3)*conv_rho chem(i,k,j,p_hc3) = chem(i,k,j,p_hc3) & +emis_ant(i,k,j,p_e_hc3)*conv_rho chem(i,k,j,p_hc5) = chem(i,k,j,p_hc5) & +emis_ant(i,k,j,p_e_hc5)*conv_rho chem(i,k,j,p_hc8) = chem(i,k,j,p_hc8) & +emis_ant(i,k,j,p_e_hc8)*conv_rho chem(i,k,j,p_eth) = chem(i,k,j,p_eth) & +emis_ant(i,k,j,p_e_eth)*conv_rho chem(i,k,j,p_co) = chem(i,k,j,p_co) & +emis_ant(i,k,j,p_e_co)*conv_rho if(p_ol2.gt.1)chem(i,k,j,p_ol2) = chem(i,k,j,p_ol2) & +emis_ant(i,k,j,p_e_ol2)*conv_rho if(p_ete.gt.1)chem(i,k,j,p_ete) = chem(i,k,j,p_ete) & +emis_ant(i,k,j,p_e_ol2)*conv_rho chem(i,k,j,p_olt) = chem(i,k,j,p_olt) & +emis_ant(i,k,j,p_e_olt)*conv_rho chem(i,k,j,p_oli) = chem(i,k,j,p_oli) & +emis_ant(i,k,j,p_e_oli)*conv_rho chem(i,k,j,p_tol) = chem(i,k,j,p_tol) & +emis_ant(i,k,j,p_e_tol)*conv_rho chem(i,k,j,p_xyl) = chem(i,k,j,p_xyl) & +emis_ant(i,k,j,p_e_xyl)*conv_rho chem(i,k,j,p_ket) = chem(i,k,j,p_ket) & +emis_ant(i,k,j,p_e_ket)*conv_rho chem(i,k,j,p_pm_25) = chem(i,k,j,p_pm_25) & +r_antro*emis_ant(i,k,j,p_e_pm_25)/rho_phy(i,k,j)/dz8w(i,k,j)*dtstep chem(i,k,j,p_pm_10) = chem(i,k,j,p_pm_10) & +r_antro*emis_ant(i,k,j,p_e_pm_10)/rho_phy(i,k,j)/dz8w(i,k,j)*dtstep 100 continue END subroutine add_emis_cptec END Module module_add_emis_cptec