drydepokernel.f90 3.88 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
subroutine drydepokernel(nunc,deposit,x,y,nage,kp)
  !                          i      i    i i  i
  !*****************************************************************************
  !                                                                            *
  !     Attribution of the deposition to the grid using a uniform kernel with  *
  !     bandwidths dx and dy.                                                  *
  !                                                                            *
  !     Author: A. Stohl                                                       *
  !                                                                            *
  !     26 December 1996                                                       *
  !                                                                            *
  !*****************************************************************************
  !                                                                            *
  ! Variables:                                                                 *
  !                                                                            *
  ! nunc             uncertainty class of the respective particle              *
  ! nage             age class of the respective particle                      *
  ! deposit          amount (kg) to be deposited                               *
  !                                                                            *
  !*****************************************************************************
21 22 23 24 25
  ! Changes:
  ! eso 10/2016: Added option to disregard kernel 
  ! 
  !*****************************************************************************

26 27 28 29 30 31 32

  use unc_mod
  use par_mod
  use com_mod

  implicit none

33 34
  real(dep_prec), dimension(maxspec) :: deposit
  real :: x,y,ddx,ddy,xl,yl,wx,wy,w
35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
  integer :: ix,jy,ixp,jyp,ks,nunc,nage,kp


  xl=(x*dx+xoutshift)/dxout
  yl=(y*dy+youtshift)/dyout
  ix=int(xl)
  jy=int(yl)
  ddx=xl-real(ix)                   ! distance to left cell border
  ddy=yl-real(jy)                   ! distance to lower cell border

  if (ddx.gt.0.5) then
    ixp=ix+1
    wx=1.5-ddx
  else
    ixp=ix-1
    wx=0.5+ddx
  endif

  if (ddy.gt.0.5) then
    jyp=jy+1
    wy=1.5-ddy
  else
    jyp=jy-1
    wy=0.5+ddy
  endif

61 62 63
  ! If no kernel is used, direct attribution to grid cell
  !******************************************************

64
  if (.not.lusekerneloutput) then
65 66 67 68 69 70 71 72 73 74 75
    do ks=1,nspec
      if ((abs(deposit(ks)).gt.0).and.DRYDEPSPEC(ks)) then
        if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgrid-1).and. &
             (jy.le.numygrid-1)) then
          drygridunc(ix,jy,ks,kp,nunc,nage)= &
               drygridunc(ix,jy,ks,kp,nunc,nage)+deposit(ks)
        end if
      end if
    end do
  else ! use kernel 

76 77 78

  ! Determine mass fractions for four grid points
  !**********************************************
79
  do ks=1,nspec
80

81
   if ((abs(deposit(ks)).gt.0).and.DRYDEPSPEC(ks)) then
82

83
      if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgrid-1).and. &
84
        (jy.le.numygrid-1)) then
85 86
        w=wx*wy
        drygridunc(ix,jy,ks,kp,nunc,nage)= &
87
           drygridunc(ix,jy,ks,kp,nunc,nage)+deposit(ks)*w
88
     endif
89

90
    if ((ixp.ge.0).and.(jyp.ge.0).and.(ixp.le.numxgrid-1).and. &
91 92 93 94
       (jyp.le.numygrid-1)) then
    w=(1.-wx)*(1.-wy)
      drygridunc(ixp,jyp,ks,kp,nunc,nage)= &
           drygridunc(ixp,jyp,ks,kp,nunc,nage)+deposit(ks)*w
95
    endif
96

97
    if ((ixp.ge.0).and.(jy.ge.0).and.(ixp.le.numxgrid-1).and. &
98
       (jy.le.numygrid-1)) then
99
      w=(1.-wx)*wy
100 101
      drygridunc(ixp,jy,ks,kp,nunc,nage)= &
           drygridunc(ixp,jy,ks,kp,nunc,nage)+deposit(ks)*w
102
    endif
103

104
    if ((ix.ge.0).and.(jyp.ge.0).and.(ix.le.numxgrid-1).and. &
105
       (jyp.le.numygrid-1)) then
106
      w=wx*(1.-wy)
107 108
      drygridunc(ix,jyp,ks,kp,nunc,nage)= &
           drygridunc(ix,jyp,ks,kp,nunc,nage)+deposit(ks)*w
109
    endif
110

111
    endif ! deposit>0
112 113
  end do
end if
114 115

end subroutine drydepokernel