wetdepokernel.f90 3.81 KB
Newer Older
1 2
! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
! SPDX-License-Identifier: GPL-3.0-or-later
3

Matthias Langer's avatar
 
Matthias Langer committed
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
subroutine wetdepokernel(nunc,deposit,x,y,nage,kp)
  !                          i      i    i i  i
  !*****************************************************************************
  !                                                                            *
  !     Attribution of the deposition from an individual particle to the       *
  !     deposition fields using a uniform kernel with bandwidths dxout and dyout.*
  !                                                                            *
  !     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                               *
  !                                                                            *
  !*****************************************************************************
24 25 26 27
  ! Changes:
  ! eso 10/2016: Added option to disregard kernel 
  ! 
  !*****************************************************************************
Matthias Langer's avatar
 
Matthias Langer committed
28 29 30 31 32 33 34 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

  use unc_mod
  use par_mod
  use com_mod

  implicit none

  real :: x,y,deposit(maxspec),ddx,ddy,xl,yl,wx,wy,w
  integer :: ix,jy,ixp,jyp,nunc,nage,ks,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
  ! If no kernel is used, direct attribution to grid cell
  !******************************************************
Matthias Langer's avatar
 
Matthias Langer committed
63

64
  if (.not.lusekerneloutput) then
65 66 67 68 69 70 71 72 73
    do ks=1,nspec
      if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgrid-1).and. &
           (jy.le.numygrid-1)) then
        wetgridunc(ix,jy,ks,kp,nunc,nage)= &
             wetgridunc(ix,jy,ks,kp,nunc,nage)+deposit(ks)
      end if
    end do
  else ! use kernel 
    
Matthias Langer's avatar
 
Matthias Langer committed
74 75 76 77 78
  ! Determine mass fractions for four grid points
  !**********************************************

  do ks=1,nspec

79
    if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgrid-1).and. &
Matthias Langer's avatar
 
Matthias Langer committed
80
       (jy.le.numygrid-1)) then
81
      w=wx*wy
Matthias Langer's avatar
 
Matthias Langer committed
82 83
      wetgridunc(ix,jy,ks,kp,nunc,nage)= &
           wetgridunc(ix,jy,ks,kp,nunc,nage)+deposit(ks)*w
84
    endif
Matthias Langer's avatar
 
Matthias Langer committed
85

86
    if ((ixp.ge.0).and.(jyp.ge.0).and.(ixp.le.numxgrid-1).and. &
Matthias Langer's avatar
 
Matthias Langer committed
87
       (jyp.le.numygrid-1)) then
88
      w=(1.-wx)*(1.-wy)
Matthias Langer's avatar
 
Matthias Langer committed
89 90
      wetgridunc(ixp,jyp,ks,kp,nunc,nage)= &
           wetgridunc(ixp,jyp,ks,kp,nunc,nage)+deposit(ks)*w
91
    endif
Matthias Langer's avatar
 
Matthias Langer committed
92

93
    if ((ixp.ge.0).and.(jy.ge.0).and.(ixp.le.numxgrid-1).and. &
Matthias Langer's avatar
 
Matthias Langer committed
94
       (jy.le.numygrid-1)) then
95
      w=(1.-wx)*wy
Matthias Langer's avatar
 
Matthias Langer committed
96 97
      wetgridunc(ixp,jy,ks,kp,nunc,nage)= &
           wetgridunc(ixp,jy,ks,kp,nunc,nage)+deposit(ks)*w
98
    endif
Matthias Langer's avatar
 
Matthias Langer committed
99

100
    if ((ix.ge.0).and.(jyp.ge.0).and.(ix.le.numxgrid-1).and. &
Matthias Langer's avatar
 
Matthias Langer committed
101
       (jyp.le.numygrid-1)) then
102
      w=wx*(1.-wy)
Matthias Langer's avatar
 
Matthias Langer committed
103 104
      wetgridunc(ix,jyp,ks,kp,nunc,nage)= &
           wetgridunc(ix,jyp,ks,kp,nunc,nage)+deposit(ks)*w
105
    endif
106

Matthias Langer's avatar
 
Matthias Langer committed
107
  end do
108
  end if
Matthias Langer's avatar
 
Matthias Langer committed
109 110

end subroutine wetdepokernel