wrfv2_fire/chem/module_emissions_anthropogenics.F

   1 MODULE module_emissions_anthropogenics
   2 !WRF:MODEL_LAYER:CHEMICS
   3 !
   4 CONTAINS
   5 !
   6 ! currently this only adds in the emissions...
   7 ! this may be done differently for different chemical mechanisms
   8 ! in the future. aerosols are already added somewhere else....
   9 !
  10    subroutine add_anthropogenics(id,dtstep,dz8w,config_flags,rho_phy,chem, &
  11                e_iso,e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl,        &
  12                e_ol2,e_olt,e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2,    &
  13                e_pm25,e_pm10,e_nh3,                                        &
  14                ids,ide, jds,jde, kds,kde,                                  &
  15                ims,ime, jms,jme, kms,kme,                                  &
  16                its,ite, jts,jte, kts,kte                                   )
  17 !----------------------------------------------------------------------
  18   USE module_configure
  19   USE module_state_description
  20   USE module_data_radm2
  21    IMPLICIT NONE
  22
  23 ! .. Parameters ..
  24    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
  25
  26    INTEGER,      INTENT(IN   ) :: id,                                      &
  27                                   ids,ide, jds,jde, kds,kde,               &
  28                                   ims,ime, jms,jme, kms,kme,               &
  29                                   its,ite, jts,jte, kts,kte
  30       REAL,      INTENT(IN   ) ::                                          &
  31                              dtstep
  32 !
  33    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ),                 &
  34          INTENT(INOUT ) ::                                   chem
  35 !
  36 ! emissions arrays
  37 !
  38 !   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                           &
  39    REAL, DIMENSION( ims:ime, kms:config_flags%kemit, jms:jme ),            &
  40          INTENT(IN ) ::                                                    &
  41            e_iso,e_so2,e_no,e_co,e_eth,e_hc3,e_hc5,e_hc8,e_xyl,e_ol2,e_olt,&
  42            e_oli,e_tol,e_csl,e_hcho,e_ald,e_ket,e_ora2,e_pm25,e_pm10,e_nh3
  43    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                           &
  44          INTENT(IN ) ::        rho_phy
  45
  46 !
  47 !
  48 !
  49
  50
  51    REAL,  DIMENSION( ims:ime , kms:kme , jms:jme )         ,               &
  52           INTENT(IN   ) ::                                                 &
  53                                                       dz8w
  54     integer i,j,k
  55     real :: conv_rho
  56 !--- deposition and emissions stuff
  57
  58
  59 ! ..
  60 ! ..
  61 ! .. Intrinsic Functions ..
  62
  63          call wrf_debug(15,'add_anhropogenics')
  64 !
  65 ! add emissions
  66 !
  67       do 100 j=jts,jte
  68       do 100 i=its,ite
  69
  70       DO k=kts,min(config_flags%kemit,kte-1)
  71         conv_rho=4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.)
  72
  73 #if (defined(CHEM_DBG_I) && defined(CHEM_DBG_J) && defined(CHEM_DBG_K))
  74        if( (i <= CHEM_DBG_I .and. i >= CHEM_DBG_I) .and. &
  75            (j <= CHEM_DBG_J .and. j >= CHEM_DBG_J) .and. &
  76            (k <= CHEM_DBG_K .and. k >= CHEM_DBG_K)  ) then
  77           print*
  78           print*,"Converted emissions for RADM2:"
  79           print*,"e_csl=",e_csl(i,k,j)*conv_rho
  80           print*,"e_iso=",e_iso(i,k,j)*conv_rho
  81           print*,"e_so2=",e_so2(i,k,j)*conv_rho
  82           print*,"e_no=",e_no(i,k,j)*conv_rho
  83           print*,"e_ald=",e_ald(i,k,j)*conv_rho
  84           print*,"e_hcho=",e_hcho(i,k,j)*conv_rho
  85           print*,"e_ora2=",e_ora2(i,k,j)*conv_rho
  86           print*,"e_nh3=",e_nh3(i,k,j)*conv_rho
  87           print*,"e_hc3=",e_hc3(i,k,j)*conv_rho
  88           print*,"e_hc5=",e_hc5(i,k,j)*conv_rho
  89           print*,"e_hc8=",e_hc8(i,k,j)*conv_rho
  90           print*,"e_eth=",e_eth(i,k,j)*conv_rho
  91           print*,"e_co=",e_co(i,k,j)*conv_rho
  92           print*,"e_ol2=",e_ol2(i,k,j)*conv_rho
  93           print*,"e_olt=",e_olt(i,k,j)*conv_rho
  94           print*,"e_oli=",e_oli(i,k,j)*conv_rho
  95           print*,"e_tol=",e_tol(i,k,j)*conv_rho
  96           print*,"e_xyl=",e_xyl(i,k,j)*conv_rho
  97           print*,"e_ket=",e_ket(i,k,j)*conv_rho
  98        end if
  99 #endif
 100
 101         chem(i,k,j,p_csl)  =  chem(i,k,j,p_csl)                        &
 102                          +e_csl(i,k,j)*conv_rho
 103         chem(i,k,j,p_iso)  = chem(i,k,j,p_iso)                         &
 104                          +e_iso(i,k,j)*conv_rho
 105         chem(i,k,j,p_so2)  = chem(i,k,j,p_so2)                         &
 106                          +e_so2(i,k,j)*conv_rho
 107         chem(i,k,j,p_no)   = chem(i,k,j,p_no)                          &
 108                          +e_no(i,k,j)*conv_rho
 109         chem(i,k,j,p_ald)  = chem(i,k,j,p_ald)                         &
 110                          +e_ald(i,k,j)*conv_rho
 111         chem(i,k,j,p_hcho) = chem(i,k,j,p_hcho)                        &
 112                          +e_hcho(i,k,j)*conv_rho
 113         chem(i,k,j,p_ora2)  = chem(i,k,j,p_ora2)                       &
 114                          +e_ora2(i,k,j)*conv_rho
 115         chem(i,k,j,p_nh3)  = chem(i,k,j,p_nh3)                         &
 116                          +e_nh3(i,k,j)*conv_rho
 117         chem(i,k,j,p_hc3)  = chem(i,k,j,p_hc3)                         &
 118                          +e_hc3(i,k,j)*conv_rho
 119         chem(i,k,j,p_hc5)  = chem(i,k,j,p_hc5)                         &
 120                          +e_hc5(i,k,j)*conv_rho
 121         chem(i,k,j,p_hc8)  = chem(i,k,j,p_hc8)                         &
 122                          +e_hc8(i,k,j)*conv_rho
 123         chem(i,k,j,p_eth)  = chem(i,k,j,p_eth)                         &
 124                          +e_eth(i,k,j)*conv_rho
 125         chem(i,k,j,p_co)  = chem(i,k,j,p_co)                           &
 126                          +e_co(i,k,j)*conv_rho
 127         if(p_ol2.gt.1)chem(i,k,j,p_ol2)  = chem(i,k,j,p_ol2)           &
 128                          +e_ol2(i,k,j)*conv_rho
 129         if(p_ete.gt.1)chem(i,k,j,p_ete)  = chem(i,k,j,p_ete)           &
 130                          +e_ol2(i,k,j)*conv_rho
 131         chem(i,k,j,p_olt)  = chem(i,k,j,p_olt)                         &
 132                          +e_olt(i,k,j)*conv_rho
 133         chem(i,k,j,p_oli)  = chem(i,k,j,p_oli)                         &
 134                          +e_oli(i,k,j)*conv_rho
 135         chem(i,k,j,p_tol)  = chem(i,k,j,p_tol)                         &
 136                          +e_tol(i,k,j)*conv_rho
 137         chem(i,k,j,p_xyl)  = chem(i,k,j,p_xyl)                         &
 138                          +e_xyl(i,k,j)*conv_rho
 139         chem(i,k,j,p_ket)  =  chem(i,k,j,p_ket)                        &
 140                          +e_ket(i,k,j)*conv_rho
 141       END DO
 142  100  continue
 143
 144     END subroutine add_anthropogenics
 145 !
 146 !
 147     subroutine add_biogenics(id,dtstep,dz8w,config_flags,rho_phy,chem, &
 148          e_bio,ne_area,                                                &
 149          ebio_iso,ebio_oli,ebio_api,ebio_lim,ebio_xyl,                 &
 150          ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald,                 &
 151          ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_nr,ebio_no,         &
 152          ids,ide, jds,jde, kds,kde,                                    &
 153          ims,ime, jms,jme, kms,kme,                                    &
 154          its,ite, jts,jte, kts,kte                                     )
 155   USE module_configure
 156   USE module_state_description
 157   USE module_data_radm2
 158   USE module_aerosols_sorgam
 159    IMPLICIT NONE
 160    INTEGER,      INTENT(IN   ) :: id,ne_area,                              &
 161                                   ids,ide, jds,jde, kds,kde,               &
 162                                   ims,ime, jms,jme, kms,kme,               &
 163                                   its,ite, jts,jte, kts,kte
 164    REAL,         INTENT(IN   ) ::                                          &
 165                              dtstep
 166    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ),                 &
 167          INTENT(INOUT ) ::                                   chem
 168    REAL, DIMENSION( ims:ime, jms:jme,ne_area ),                            &
 169          INTENT(IN ) ::                                                    &
 170                  e_bio
 171    REAL, DIMENSION( ims:ime, jms:jme ),                                    &
 172          INTENT(IN ) ::                                                    &
 173          ebio_iso,ebio_oli,ebio_api,ebio_lim,ebio_xyl,                     &
 174          ebio_hc3,ebio_ete,ebio_olt,ebio_ket,ebio_ald,                     &
 175          ebio_hcho,ebio_eth,ebio_ora2,ebio_co,ebio_nr,ebio_no
 176
 177 !
 178 !
 179 !
 180
 181    REAL,  DIMENSION( ims:ime , kms:kme , jms:jme )         ,               &
 182           INTENT(IN   ) ::                                                 &
 183                                           rho_phy,dz8w
 184     integer i,j,k,n
 185     real :: conv_rho
 186 !--- deposition and emissions stuff
 187 ! .. Parameters ..
 188    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 189 !  return
 190    bioem_select: SELECT CASE(config_flags%bio_emiss_opt)
 191      CASE (GUNTHER1)
 192      CALL wrf_debug(15,'adding biogenic emissions: Gunther1')
 193 !     DO n = 1, numgas-2
 194       do 100 j=jts,jte
 195       do 100 i=its,ite
 196         conv_rho=dtstep/(dz8w(i,kts,j)*60.)
 197         chem(i,kts,j,p_iso)=chem(i,kts,j,p_iso)+ &
 198                   e_bio(i,j,p_iso-1)*conv_rho
 199         chem(i,kts,j,p_oli)=chem(i,kts,j,p_oli)+ &
 200                   e_bio(i,j,p_oli-1)*conv_rho
 201         chem(i,kts,j,p_xyl)=chem(i,kts,j,p_xyl)+ &
 202                   e_bio(i,j,p_xyl-1)*conv_rho
 203         chem(i,kts,j,p_hc3)=chem(i,kts,j,p_hc3)+ &
 204                   e_bio(i,j,p_hc3-1)*conv_rho
 205         chem(i,kts,j,p_olt)=chem(i,kts,j,p_olt)+ &
 206                   e_bio(i,j,p_olt-1)*conv_rho
 207         chem(i,kts,j,p_ket)=chem(i,kts,j,p_ket)+ &
 208                   e_bio(i,j,p_ket-1)*conv_rho
 209         chem(i,kts,j,p_ald)=chem(i,kts,j,p_ald)+ &
 210                   e_bio(i,j,p_ald-1)*conv_rho
 211         chem(i,kts,j,p_hcho)=chem(i,kts,j,p_hcho)+ &
 212                   e_bio(i,j,p_hcho-1)*conv_rho
 213         chem(i,kts,j,p_eth)=chem(i,kts,j,p_eth)+ &
 214                   e_bio(i,j,p_eth-1)*conv_rho
 215         chem(i,kts,j,p_ora2)=chem(i,kts,j,p_ora2)+ &
 216                   e_bio(i,j,p_ora2-1)*conv_rho
 217         chem(i,kts,j,p_co)=chem(i,kts,j,p_co)+ &
 218                   e_bio(i,j,p_co-1)*conv_rho
 219         chem(i,kts,j,p_no)=chem(i,kts,j,p_no)+ &
 220                   e_bio(i,j,p_no-1)*conv_rho
 221 !
 222 ! RADM only
 223 !
 224         if(p_ol2.gt.1)chem(i,kts,j,p_ol2)=chem(i,kts,j,p_ol2)+ &
 225                   e_bio(i,j,p_ol2-1)*conv_rho
 226  100  continue
 227 !     enddo
 228      CASE (BEIS311)
 229      CALL wrf_debug(100,'adding biogenic emissions: beis3.1.1')
 230       do j=jts,jte
 231       do i=its,ite
 232         conv_rho=4.828e-4/rho_phy(i,kts,j)*dtstep/(dz8w(i,kts,j)*60.)
 233         chem(i,kts,j,p_iso)=chem(i,kts,j,p_iso)+ &
 234                   ebio_iso(i,j)*conv_rho
 235         chem(i,kts,j,p_oli)=chem(i,kts,j,p_oli)+ &
 236                   ebio_oli(i,j)*conv_rho
 237         chem(i,kts,j,p_xyl)=chem(i,kts,j,p_xyl)+ &
 238                   ebio_xyl(i,j)*conv_rho
 239         chem(i,kts,j,p_hc3)=chem(i,kts,j,p_hc3)+ &
 240                   ebio_hc3(i,j)*conv_rho
 241         chem(i,kts,j,p_olt)=chem(i,kts,j,p_olt)+ &
 242                   ebio_olt(i,j)*conv_rho
 243         chem(i,kts,j,p_ket)=chem(i,kts,j,p_ket)+ &
 244                   ebio_ket(i,j)*conv_rho
 245         chem(i,kts,j,p_ald)=chem(i,kts,j,p_ald)+ &
 246                   ebio_ald(i,j)*conv_rho
 247         chem(i,kts,j,p_hcho)=chem(i,kts,j,p_hcho)+ &
 248                   ebio_hcho(i,j)*conv_rho
 249         chem(i,kts,j,p_eth)=chem(i,kts,j,p_eth)+ &
 250                   ebio_eth(i,j)*conv_rho
 251         chem(i,kts,j,p_ora2)=chem(i,kts,j,p_ora2)+ &
 252                   ebio_ora2(i,j)*conv_rho
 253         chem(i,kts,j,p_co)=chem(i,kts,j,p_co)+ &
 254                   ebio_co(i,j)*conv_rho
 255         chem(i,kts,j,p_no)=chem(i,kts,j,p_no)+ &
 256                   ebio_no(i,j)*conv_rho
 257 !
 258 ! RADM only
 259 !
 260         if(p_ol2.gt.1)chem(i,kts,j,p_ol2)=chem(i,kts,j,p_ol2)+ &
 261                   ebio_ete(i,j)*conv_rho
 262 !
 263 ! RACM only
 264 !
 265         if(p_api.gt.1)chem(i,kts,j,p_api)=chem(i,kts,j,p_api)+ &
 266                   ebio_api(i,j)*conv_rho
 267         if(p_lim.gt.1)chem(i,kts,j,p_lim)=chem(i,kts,j,p_lim)+ &
 268                   ebio_lim(i,j)*conv_rho
 269         if(p_ete.gt.1)chem(i,kts,j,p_ete)=chem(i,kts,j,p_ete)+ &
 270                   ebio_ete(i,j)*conv_rho
 271       enddo
 272       enddo
 273      CASE DEFAULT
 274
 275    END SELECT bioem_select
 276     END subroutine add_biogenics
 277
 278
 279 END MODULE module_emissions_anthropogenics