chem/module_wetdep_ls.F

   1 MODULE module_wetdep_ls
   2 USE module_state_description, only:p_qv,p_qc,p_so2,p_sulf, &
   3                               p_bc1,p_bc2,p_oc1,p_oc2,p_seas_1,p_seas_2,     &
   4                               p_seas_3,p_seas_4,p_dms
   5
   6 CONTAINS
   7 subroutine wetdep_ls(dt,var,rain,moist,rho,num_moist, &
   8          num_chem,numgas,dz8w,vvel,chem_opt,             &
   9          ids,ide, jds,jde, kds,kde,                                        &
  10          ims,ime, jms,jme, kms,kme,                                        &
  11          its,ite, jts,jte, kts,kte                                         )
  12   IMPLICIT NONE
  13
  14    INTEGER,      INTENT(IN   ) :: num_chem,numgas,num_moist,               &
  15                                   chem_opt,                                &
  16                                   ids,ide, jds,jde, kds,kde,               &
  17                                   ims,ime, jms,jme, kms,kme,               &
  18                                   its,ite, jts,jte, kts,kte
  19    real, INTENT(IN ) :: dt
  20     REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_moist ),                &
  21          INTENT(IN ) ::                                   moist
  22    REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ),                        &
  23           INTENT(IN   ) :: rho,dz8w,vvel
  24    REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ,1:num_chem),                        &
  25           INTENT(INOUT) :: var
  26    REAL,  DIMENSION( ims:ime , jms:jme ),                                  &
  27           INTENT(IN   ) :: rain
  28 !  REAL,  DIMENSION( ims:ime ,  jms:jme ),                                  &
  29 !         INTENT(INOUT   ) :: var_rmv
  30    REAL,  DIMENSION( its:ite ,  jts:jte ) :: var_sum,var_rmv
  31    REAL,  DIMENSION( its:ite ,  kts:kte, jts:jte ) :: var_rmvl
  32    REAL,  DIMENSION( its:ite ,  jts:jte ) :: frc,var_sum_clw,rain_clw
  33     real :: dvar,factor,clsum,alpha,rho_water
  34    integer :: nv,i,j,k,km,kb,kbeg
  35     rho_water = 1000.
  36 !   write(0,*) 'in wetdepls, numgas,num_chem = ',numgas,num_chem,chem_opt
  37 !   nv=p_bc1
  38     do nv=1,num_chem
  39        if(nv.le. numgas .and. nv.ne.p_sulf)cycle
  40        alpha = .5    ! scavenging factor
  41        if(chem_opt >= 300)then
  42           if(nv.eq.p_bc1 .or. nv.eq.p_oc1 .or. nv.eq.p_dms)cycle
  43           if(nv.eq.p_bc2 .or. nv.eq.p_oc2)alpha=0.8
  44        endif
  45        if(nv.eq.p_sulf .or. nv.eq.p_seas_1 .or. nv.eq.p_seas_2    &
  46                        .or. nv.eq.p_seas_3 .or. nv.eq.p_seas_4)alpha=1.
  47        do i=its,ite
  48        do j=jts,jte
  49         var_sum_clw(i,j)=0.
  50         var_sum(i,j)=0.
  51         var_rmvl(i,:,j)=0.
  52         frc(i,j)=0.
  53         rain_clw(i,j)=0.
  54         if(rain(i,j).gt.1.e-10)then
  55 !          write(0,*)i,j,rain(i,j)
  56 ! convert rain back to rate
  57 !
  58            rain_clw(i,j)=rain(i,j)/dt
  59 ! total cloud water
  60 !
  61            do k=1,kte-1
  62               dvar=max(0.,moist(i,k,j,p_qc)*rho(i,k,j)*vvel(i,k,j)*dz8w(i,k,j))
  63               var_sum_clw(i,j)=var_sum_clw(i,j)+dvar
  64               var_sum(i,j)=var_sum(i,j)+var(i,k,j,nv)*rho(i,k,j)
  65            enddo
  66            if(var_sum(i,j).gt.1.e-10 .and. var_sum_clw(i,j).gt.1.e-10 ) then
  67    !        assuming that frc is onstant, it is my conversion factor
  68 !       (just like in convec. parameterization
  69               frc(i,j)=rain_clw(i,j)/var_sum_clw(i,j)
  70 !    write(0,*)'frc ', frc(i,j),var_sum_clw(i,j),var_sum(i,j)
  71               frc(i,j)=max(1.e-6,min(frc(i,j),.005))
  72            endif
  73         endif
  74       enddo
  75     enddo
  76 !
  77 ! get rid of it
  78 !
  79     do i=its,ite
  80     do j=jts,jte
  81      if(rain(i,j).gt.1.e-10 .and. var_sum(i,j).gt.1.e-10 .and. var_sum_clw(i,j).gt.1.e-10)then
  82        do k=kts,kte-2
  83         if(var(i,k,j,nv).gt.1.e-16 .and. moist(i,k,j,p_qc).gt.0.)then
  84         factor = max(0.,frc(i,j)*rho(i,k,j)*dz8w(i,k,j)*vvel(i,k,j))
  85 !       write(0,*)'var before ',k,km,var(i,k,j,nv),factor
  86         dvar=alpha*factor/(1+factor)*var(i,k,j,nv)
  87         var(i,k,j,nv)=max(1.e-16,var(i,k,j,nv)-dvar)
  88 !       write(0,*)'var after ',km,var(i,k,j,nv),dvar
  89         endif
  90        enddo
  91 !      var_rmv(i,j)=var_rmv(i,j)+var_rmvl(i,j)
  92     endif
  93     enddo
  94     enddo
  95     enddo
  96 END SUBROUTINE WETDEP_LS
  97 END MODULE module_wetdep_ls
  98
  99