drydepokernel.f90 3.88 KB
Newer Older
Matthias Langer's avatar
 
Matthias Langer committed
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 
  ! 
  !*****************************************************************************

Matthias Langer's avatar
 
Matthias Langer committed
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
Matthias Langer's avatar
 
Matthias Langer committed
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 

Matthias Langer's avatar
 
Matthias Langer committed
76 77 78

  ! Determine mass fractions for four grid points
  !**********************************************
79
  do ks=1,nspec
Matthias Langer's avatar
 
Matthias Langer committed
80

81
   if ((abs(deposit(ks)).gt.0).and.DRYDEPSPEC(ks)) then
Matthias Langer's avatar
 
Matthias Langer committed
82

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

90
    if ((ixp.ge.0).and.(jyp.ge.0).and.(ixp.le.numxgrid-1).and. &
Matthias Langer's avatar
 
Matthias Langer committed
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
Matthias Langer's avatar
 
Matthias Langer committed
96

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

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

111
    endif ! deposit>0
112 113
  end do
end if
Matthias Langer's avatar
 
Matthias Langer committed
114 115

end subroutine drydepokernel