source: flexpart.git/src/wetdepokernel_nest.f90

10.4.1_peseiGFS_025bugfixes+enhancementsdevrelease-10release-10.4.1scaling-bug
Last change on this file was 92fab65, checked in by Ignacio Pisso <ip@…>, 4 years ago

add SPDX-License-Identifier to all .f90 files

  • Property mode set to 100644
File size: 3.9 KB
Line 
1! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
2! SPDX-License-Identifier: GPL-3.0-or-later
3
4subroutine wetdepokernel_nest(nunc,deposit,x,y,nage,kp)
5  !                           i    i       i i i    i
6  !*****************************************************************************
7  !                                                                            *
8  !     Attribution of the deposition from an individual particle to the       *
9  !     nested deposition fields using a uniform kernel with bandwidths        *
10  !     dxoutn and dyoutn.                                                     *
11  !                                                                            *
12  !     Author: A. Stohl                                                       *
13  !                                                                            *
14  !     26 December 1996                                                       *
15  !                                                                            *
16  !      2 September 2004: Adaptation from wetdepokernel.                      *
17  !                                                                            *
18  !                                                                            *
19  !*****************************************************************************
20  !                                                                            *
21  ! Variables:                                                                 *
22  !                                                                            *
23  ! nunc             uncertainty class of the respective particle              *
24  ! nage             age class of the respective particle                      *
25  ! deposit          amount (kg) to be deposited                               *
26  !                                                                            *
27  !*****************************************************************************
28
29  use unc_mod
30  use par_mod
31  use com_mod
32
33  implicit none
34
35  real :: x,y,deposit(maxspec),ddx,ddy,xl,yl,wx,wy,w
36  integer :: ix,jy,ixp,jyp,ks,kp,nunc,nage
37
38  xl=(x*dx+xoutshiftn)/dxoutn
39  yl=(y*dy+youtshiftn)/dyoutn
40
41  ! old:
42  ! ix=int(xl)
43  ! jy=int(yl)
44
45  ! ESO: for xl,yl in range <-.5,-1> we get ix,jy=0 and thus negative
46  ! wx,wy as the int function rounds upwards for negative numbers.
47  ! Either use the floor function, or (perhaps more correctly?) use "(xl.gt.-0.5)"
48  ! in place of "(ix.ge.0)" and similar for the upper boundary.
49
50  ! new:
51  ix=floor(xl)
52  jy=floor(yl)
53
54  ddx=xl-real(ix)                   ! distance to left cell border
55  ddy=yl-real(jy)                   ! distance to lower cell border
56
57
58  if (ddx.gt.0.5) then
59    ixp=ix+1
60    wx=1.5-ddx
61  else
62    ixp=ix-1
63    wx=0.5+ddx
64  endif
65
66  if (ddy.gt.0.5) then
67    jyp=jy+1
68    wy=1.5-ddy
69  else
70    jyp=jy-1
71    wy=0.5+ddy
72  endif
73
74! Determine mass fractions for four grid points
75!**********************************************
76
77  do ks=1,nspec
78    if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgridn-1).and. &
79         (jy.le.numygridn-1)) then
80      w=wx*wy
81      wetgriduncn(ix,jy,ks,kp,nunc,nage)= &
82           wetgriduncn(ix,jy,ks,kp,nunc,nage)+deposit(ks)*w
83    endif
84
85    if ((ixp.ge.0).and.(jyp.ge.0).and.(ixp.le.numxgridn-1).and. &
86         (jyp.le.numygridn-1)) then
87      w=(1.-wx)*(1.-wy)
88      wetgriduncn(ixp,jyp,ks,kp,nunc,nage)= &
89           wetgriduncn(ixp,jyp,ks,kp,nunc,nage)+deposit(ks)*w
90    endif
91
92    if ((ixp.ge.0).and.(jy.ge.0).and.(ixp.le.numxgridn-1).and. &
93         (jy.le.numygridn-1)) then
94      w=(1.-wx)*wy
95      wetgriduncn(ixp,jy,ks,kp,nunc,nage)= &
96           wetgriduncn(ixp,jy,ks,kp,nunc,nage)+deposit(ks)*w
97    endif
98
99    if ((ix.ge.0).and.(jyp.ge.0).and.(ix.le.numxgridn-1).and. &
100         (jyp.le.numygridn-1)) then
101      w=wx*(1.-wy)
102      wetgriduncn(ix,jyp,ks,kp,nunc,nage)= &
103           wetgriduncn(ix,jyp,ks,kp,nunc,nage)+deposit(ks)*w
104    endif
105
106  end do
107end subroutine wetdepokernel_nest
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG