chem/module_gocart_aerosols.F

   1 MODULE module_gocart_aerosols
   2   USE module_model_constants, only: mwdry
   3     INTEGER, PARAMETER ::NBC1=1, NOC1=2, NBC2=3, NOC2=4
   4
   5 CONTAINS
   6   subroutine gocart_aerosols_driver(ktau,dt,config_flags,t_phy,moist,  &
   7          chem,rho_phy,dz8w,p8w,dx,g,         &
   8          ids,ide, jds,jde, kds,kde,                                        &
   9          ims,ime, jms,jme, kms,kme,                                        &
  10          its,ite, jts,jte, kts,kte                                         )
  11   USE module_configure
  12   USE module_state_description
  13   IMPLICIT NONE
  14    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
  15
  16    INTEGER,      INTENT(IN   ) :: ktau,                     &
  17                                   ids,ide, jds,jde, kds,kde,               &
  18                                   ims,ime, jms,jme, kms,kme,               &
  19                                   its,ite, jts,jte, kts,kte
  20     REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_moist ),                &
  21          INTENT(IN ) ::                                   moist
  22    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ),                 &
  23          INTENT(INOUT ) ::                                   chem
  24    REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ),                        &
  25           INTENT(IN   ) ::                     t_phy,               &
  26                                             dz8w,p8w,      &
  27                                               rho_phy
  28
  29   REAL, INTENT(IN   ) :: dt,dx,g
  30   integer :: ndt1,nmx,i,j,k,imx,jmx,lmx
  31   real*8, DIMENSION (1,1,1) :: tmp,airden,airmas
  32   REAL*8    :: chmlos(1,1,1,4)
  33   REAL*8    :: bchmlos(1,1,4)
  34   REAL*8 :: pc2(1,1,1,2)
  35   REAL*8 :: tc(4),tt1,tt2
  36   real, parameter :: mw_c = 12.
  37 ! .. Intrinsic Functions ..
  38         INTRINSIC abs
  39
  40        imx=1
  41        jmx=1
  42        lmx=1
  43        nmx=4
  44        ndt1=ifix(dt)
  45 !
  46 !
  47        do j=jts,jte
  48        do k=kts,kte-1
  49        do i=its,ite
  50           airmas(1,1,1)=-(p8w(i,k+1,j)-p8w(i,k,j))*dx*dx/g
  51           pc2(1,1,1,1)=0.
  52           pc2(1,1,1,2)=0.
  53           tc(1)=chem(i,k,j,p_bc1)/mw_c*mwdry*1.d-9
  54           tc(2)=chem(i,k,j,p_oc1)/mw_c*mwdry*1.d-9
  55           tc(3)=chem(i,k,j,p_bc2)/mw_c*mwdry*1.d-9
  56           tc(4)=chem(i,k,j,p_oc2)/mw_c*mwdry*1.d-9
  57           tt1=tc(3)
  58
  59          CALL chem_1(imx,jmx,lmx, nmx, ndt1, airmas, tc, &
  60               chmlos, bchmlos, pc2)
  61          CALL chem_2(imx,jmx,lmx, nmx, ndt1, airmas, tc, pc2)
  62 !
  63 ! how much bc is aged, oc production (since no SOA) is made
  64 ! dependent on that
  65 !
  66           tt2=tc(3)-tt1
  67           chem(i,k,j,p_bc1)=tc(1)/mwdry*mw_c*1.e9
  68           chem(i,k,j,p_oc1)=tc(2)/mwdry*mw_c*1.e9
  69           chem(i,k,j,p_bc2)=tc(3)/mwdry*mw_c*1.e9
  70           chem(i,k,j,p_oc2)=(tc(4)+8.*tt2)/mwdry*mw_c*1.e9
  71
  72        enddo
  73        enddo
  74        enddo
  75 end subroutine gocart_aerosols_driver
  76        subroutine sum_pm_gocart (                                      &
  77             alt, chem,pm2_5_dry, pm2_5_dry_ec, pm10,                   &
  78             ids,ide, jds,jde, kds,kde,                                 &
  79             ims,ime, jms,jme, kms,kme,                                 &
  80             its,ite, jts,jte, kts,kte                                  )
  81    USE module_configure
  82    USE module_state_description
  83    USE module_data_gocartchem, only: nh4_mfac,oc_mfac
  84    IMPLICIT NONE
  85    REAL, PARAMETER :: mwso4 = 96.0576
  86    INTEGER,      INTENT(IN   ) :: ids,ide, jds,jde, kds,kde,               &
  87                                   ims,ime, jms,jme, kms,kme,               &
  88                                   its,ite, jts,jte, kts,kte
  89     REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                          &
  90          INTENT(INOUT ) :: pm2_5_dry, pm2_5_dry_ec, pm10
  91     REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                          &
  92          INTENT(IN ) :: alt
  93    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ),                 &
  94          INTENT(IN ) ::                                   chem
  95    real d_2_5,s_2_5,d_10,sulfate
  96    integer i,j,k,ii,jj,n
  97     d_2_5=0.380       ! ln(2.5/2)/ln(3.6/2)
  98     s_2_5=0.834       ! ln(2.5/1)/ln(3/1)
  99     d_10=0.737        ! ln(10/6)/ln(12/6)
 100
 101 !
 102 ! sum up pm2_5 and pm10 output
 103 !
 104       pm2_5_dry(its:ite, kts:kte, jts:jte)    = 0.
 105       pm10(its:ite, kts:kte, jts:jte)    = 0.
 106       pm2_5_dry_ec(its:ite, kts:kte, jts:jte) = 0.
 107       do j=jts,jte
 108          jj=min(jde-1,j)
 109          do k=kts,kte
 110          do i=its,ite
 111             ii=min(ide-1,i)
 112             sulfate=chem(ii,k,jj,p_sulf)*mwso4/mwdry*1.e3
 113             do n=p_p25,p_dust_1
 114                pm2_5_dry(i,k,j) = pm2_5_dry(i,k,j)+chem(ii,k,jj,n)
 115             enddo
 116             pm2_5_dry(i,k,j) = pm2_5_dry(i,k,j)+chem(ii,k,jj,p_dust_2)*d_2_5     &
 117                                             +chem(ii,k,jj,p_seas_1)           &
 118                                             +chem(ii,k,jj,p_seas_2)*s_2_5     &
 119                                             +sulfate*nh4_mfac                 &
 120                                             +(chem(ii,k,jj,p_oc1)+chem(ii,k,jj,p_oc2))*(oc_mfac-1.)
 121
 122             !Convert the units from mixing ratio to concentration (ug m^-3)
 123             pm2_5_dry(i,k,j)    = pm2_5_dry(i,k,j) / alt(ii,k,jj)
 124       enddo
 125       enddo
 126       enddo
 127       do j=jts,jte
 128          jj=min(jde-1,j)
 129          do k=kts,kte
 130             do i=its,ite
 131                ii=min(ide-1,i)
 132                sulfate=chem(ii,k,jj,p_sulf)*mwso4/mwdry*1.e3
 133                do n=p_p25,p_dust_3
 134                   pm10(i,k,j) = pm10(i,k,j)+chem(ii,k,jj,n)
 135                enddo
 136                do n=p_seas_1,p_seas_3
 137                   pm10(i,k,j) = pm10(i,k,j)+chem(ii,k,jj,n)
 138                enddo
 139                pm10(i,k,j) = pm10(i,k,j) + sulfate*nh4_mfac        &
 140                             +chem(ii,k,jj,p_dust_4)*d_10           &
 141                             +chem(ii,k,jj,p_p10)                &
 142                             +(chem(ii,k,jj,p_oc1)+chem(ii,k,jj,p_oc2))*(oc_mfac-1.)
 143                pm10(i,k,j) = pm10(i,k,j)/ alt(ii,k,jj)
 144             enddo
 145          enddo
 146       enddo
 147
 148 end subroutine sum_pm_gocart
 149
 150 SUBROUTINE chem_1(imx,jmx,lmx, nmx, &
 151      ndt1, airm, tc, chmlos, bchmlos, pc2)
 152 ! ****************************************************************************
 153 ! **                                                                        **
 154 ! **  For tracers with dry deposition, the loss rate of dry dep is combined **
 155 ! **  in chem loss term. Assuming a conversion time of 2.5 days (1-4 days,  **
 156 ! **  Lynn Russell) of conversion time from hydrophobic to hydrophilic.     **
 157 ! **     BC1 --> BC2         k = 4.63e-6                                    **
 158 ! **     OC1 --> OC2         k = 4.63e-6                                    **
 159 ! **     BC1 --> drydep      kd = DRYDf (sec-1)                             **
 160 ! **     OC1 --> drydep      kd = DRYDf (sec-1)                             **
 161 ! **                                                                        **
 162 ! ****************************************************************************
 163
 164
 165   IMPLICIT NONE
 166
 167   INTEGER, INTENT(IN)    :: lmx, nmx,imx,jmx, ndt1
 168   REAL*8,    INTENT(IN)    :: airm(imx,jmx,lmx)
 169   REAL*8,    INTENT(INOUT) :: tc(imx,jmx,lmx,nmx)
 170   REAL*8,    INTENT(INOUT) :: chmlos(imx,jmx,lmx,nmx)
 171   REAL*8,    INTENT(INOUT) :: bchmlos(imx,jmx,nmx)
 172   REAL*8,    INTENT(OUT)   :: pc2(imx,jmx,lmx,2)
 173
 174   REAL*8 :: r1, c0, r2, rkt, c1
 175   INTEGER :: np, n, i, j, l
 176
 177   ! executable statements
 178
 179   r1 = 4.63D-6
 180
 181   DO n = 1,nmx
 182      IF (n == NBC1 .OR. n == NOC1) THEN
 183         IF (n == NBC1) np = 1
 184         IF (n == NOC1) np = 2
 185         DO l = 1,lmx
 186            DO j = 1,jmx
 187               DO i = 1,imx
 188
 189                  c0 = tc(i,j,l,n)
 190                  r2 = 0.0 ! used to be loss due to dry dep
 191                  rkt = (r1 + r2) * REAL(ndt1)
 192
 193                  c1 = c0 *  EXP(-rkt)
 194                  c1 = MAX(c1, 1.0D-32)
 195                  tc(i,j,l,n) = c1
 196
 197                  pc2(i,j,l,np) = (c0 - c1) * r1/(r1 + r2)
 198
 199                  !   Diagnostics:
 200 !                chmlos(i,j,l,np) = chmlos(i,j,l,np) + pc2(i,j,l,n)*airm(i,j,l)
 201                  chmlos(i,j,l,n) = chmlos(i,j,l,n) + pc2(i,j,l,np)*airm(i,j,l)
 202
 203               END DO
 204            END DO
 205         END DO
 206
 207         DO j = 1,jmx
 208            DO i = 1,imx
 209               bchmlos(i,j,n) = bchmlos(i,j,n) + SUM(chmlos(i,j,:,n))
 210            END DO
 211         END DO
 212
 213      END IF
 214   END DO
 215
 216 END SUBROUTINE chem_1
 217
 218 SUBROUTINE chem_2(imx,jmx,lmx, nmx, &
 219                   ndt1, airm, tc,  pc2)
 220 ! ****************************************************************************
 221 ! *                                                                          *
 222 ! *  C2 = C2_0 * exp(-kt) + PC2/kt * (1.-exp(-kt))                           *
 223 ! *    where k = dry deposition, C2 = BC2 or OC2.                            *
 224 ! *                                                                          *
 225 ! ****************************************************************************
 226
 227
 228   IMPLICIT NONE
 229
 230   INTEGER, INTENT(IN)    :: lmx,imx,jmx, nmx, ndt1
 231   REAL*8,    INTENT(IN)    :: airm(imx,jmx,lmx)
 232   REAL*8,    INTENT(INOUT) :: tc(imx,jmx,lmx,nmx)
 233   REAL*8,    INTENT(IN)    :: pc2(imx,jmx,lmx,2)
 234
 235   INTEGER :: np, n, i, j, l
 236   REAL*8  :: c0, pp, rkt, c1
 237
 238   ! executable statements
 239
 240   DO n = 1,nmx
 241      IF (n == NBC2 .OR. n == NOC2) THEN
 242         IF (n == NBC2) np = 1
 243         IF (n == NOC2) np = 2
 244 !CMIC$ doall autoscope
 245         DO l = 1,lmx
 246            DO j = 1,jmx
 247               DO i = 1,imx
 248
 249                  c0 = tc(i,j,l,n)
 250 !                 pp = pc2(i,j,l,n)
 251                  pp = pc2(i,j,l,np)
 252                  c1 = c0 + pp
 253
 254                  c1 = MAX(c1, 1.0D-32)
 255                  tc(i,j,l,n) = c1
 256
 257
 258               END DO
 259            END DO
 260         END DO
 261      END IF
 262   END DO
 263
 264 END SUBROUTINE chem_2
 265
 266 END MODULE module_gocart_aerosols