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