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