wetdepo.f90 6.34 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
subroutine wetdepo(itime,ltsample,loutnext)
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
!                  i      i        i
!*****************************************************************************
!                                                                            *
! Calculation of wet deposition using the concept of scavenging coefficients.*
! For lack of detailed information, washout and rainout are jointly treated. *
! It is assumed that precipitation does not occur uniformly within the whole *
! grid cell, but that only a fraction of the grid cell experiences rainfall. *
! This fraction is parameterized from total cloud cover and rates of large   *
! scale and convective precipitation.                                        *
!                                                                            *
!    Author: A. Stohl                                                        *
!                                                                            *
!    1 December 1996                                                         *
!                                                                            *
! Correction by Petra Seibert, Sept 2002:                                    *
! use centred precipitation data for integration                             *
! Code may not be correct for decay of deposition!                           *
!                                                                            *
!*****************************************************************************
!                                                                            *
! Variables:                                                                 *
! ix,jy              indices of output grid cell for each particle           *
! itime [s]          actual simulation time [s]                              *
! jpart              particle index                                          *
! ldeltat [s]        interval since radioactive decay was computed           *
! loutnext [s]       time for which gridded deposition is next output        *
! loutstep [s]       interval at which gridded deposition is output          *
! ltsample [s]       interval over which mass is deposited                   *
! wetdeposit         mass that is wet deposited                              *
! wetgrid            accumulated deposited mass on output grid               *
! wetscav            scavenging coefficient                                  *
!                                                                            *
! Constants:                                                                 *
!                                                                            *
!*****************************************************************************
Matthias Langer's avatar
 
Matthias Langer committed
40
41
42
43
44
45
46

  use point_mod
  use par_mod
  use com_mod

  implicit none

Espen Sollum's avatar
Espen Sollum committed
47
48
  integer :: jpart,itime,ltsample,loutnext,ldeltat
  integer :: itage,nage
49
  integer :: ks, kp
50
  integer(selected_int_kind(16)), dimension(nspec) :: blc_count, inc_count
51
  real :: grfraction(3),wetscav
Matthias Langer's avatar
 
Matthias Langer committed
52
53
  real :: wetdeposit(maxspec),restmass
  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
54

55
56
! Compute interval since radioactive decay of deposited mass was computed
!************************************************************************
Matthias Langer's avatar
 
Matthias Langer committed
57
58
59
60
61
62
63

  if (itime.le.loutnext) then
    ldeltat=itime-(loutnext-loutstep)
  else                                  ! first half of next interval
    ldeltat=itime-loutnext
  endif

64
65
! Loop over all particles
!************************
Matthias Langer's avatar
 
Matthias Langer committed
66

67
68
  blc_count(:)=0
  inc_count(:)=0
69

Matthias Langer's avatar
 
Matthias Langer committed
70
  do jpart=1,numpart
71

Matthias Langer's avatar
 
Matthias Langer committed
72
73
74
75
76
77
    if (itra1(jpart).eq.-999999999) goto 20
    if(ldirect.eq.1)then
      if (itra1(jpart).gt.itime) goto 20
    else
      if (itra1(jpart).lt.itime) goto 20
    endif
78

79
! Determine age class of the particle - nage is used for the kernel
80
!******************************************************************
81
82
83
84
85
     itage=abs(itra1(jpart)-itramem(jpart))
     do nage=1,nageclass
       if (itage.lt.lage(nage)) goto 33
     end do
 33  continue
86

Sabine's avatar
Sabine committed
87
    do ks=1,nspec      ! loop over species
88

89
      if (WETDEPSPEC(ks).eqv..false.) cycle 
90
91
92
93

!**************************************************
! CALCULATE DEPOSITION 
!**************************************************
94
!       wetscav=0.
95
       
Sabine's avatar
Sabine committed
96
!        write(*,*) ks,dquer(ks), crain_aero(ks),csnow_aero(ks)
97
98
99
100
!       if (((dquer(ks).le.0.).and.(weta_gas(ks).gt.0..or.wetb_gas(ks).gt.0.)) &
!          .or. &
!          ((dquer(ks).gt.0.).and.(crain_aero(ks).gt.0..or.csnow_aero(ks).gt.0.).or. &
!            (ccn_aero(ks).gt0) .or. (in_aero(ks).gt.0) .or. (henry(ks).gt.0)))  then
101

Sabine's avatar
Sabine committed
102
      call get_wetscav(itime,ltsample,loutnext,jpart,ks,grfraction,inc_count,blc_count,wetscav)
103
      
Matthias Langer's avatar
 
Matthias Langer committed
104

105
      if (wetscav.gt.0.) then
Matthias Langer's avatar
 
Matthias Langer committed
106
        wetdeposit(ks)=xmass1(jpart,ks)* &
Espen Sollum's avatar
Espen Sollum committed
107
             (1.-exp(-wetscav*abs(ltsample)))*grfraction(1)  ! wet deposition
108
109
110
      else ! if no scavenging
        wetdeposit(ks)=0.
      endif
111
 
112
113
114
115
116
117
118
119
      restmass = xmass1(jpart,ks)-wetdeposit(ks)
      if (ioutputforeachrelease.eq.1) then
        kp=npoint(jpart)
      else
        kp=1
      endif
      if (restmass .gt. smallnum) then
        xmass1(jpart,ks)=restmass
120
121
122
!   depostatistic
!   wetdepo_sum(ks,kp)=wetdepo_sum(ks,kp)+wetdeposit(ks)
!   depostatistic
123
124
125
      else
        xmass1(jpart,ks)=0.
      endif
126
127
!   Correct deposited mass to the last time step when radioactive decay of
!   gridded deposited mass was calculated
128
129
130
      if (decay(ks).gt.0.) then
        wetdeposit(ks)=wetdeposit(ks)*exp(abs(ldeltat)*decay(ks))
      endif
131

Sabine's avatar
Sabine committed
132
!    endif ! no deposition
Sabine's avatar
Sabine committed
133
    end do ! loop over species
Matthias Langer's avatar
 
Matthias Langer committed
134

135
136
137
! Sabine Eckhardt, June 2008 create deposition runs only for forward runs
! Add the wet deposition to accumulated amount on output grid and nested output grid
!*****************************************************************************
Matthias Langer's avatar
 
Matthias Langer committed
138

139
140
    if (ldirect.eq.1) then
      call wetdepokernel(nclass(jpart),wetdeposit,real(xtra1(jpart)), &
Espen Sollum's avatar
Espen Sollum committed
141
           real(ytra1(jpart)),nage,kp)
142
      if (nested_output.eq.1) call wetdepokernel_nest(nclass(jpart), &
Espen Sollum's avatar
Espen Sollum committed
143
           wetdeposit,real(xtra1(jpart)),real(ytra1(jpart)),nage,kp)
144
    endif
Matthias Langer's avatar
 
Matthias Langer committed
145
146

20  continue
147
  end do ! all particles
Matthias Langer's avatar
 
Matthias Langer committed
148

149
! count the total number of below-cloud and in-cloud occurences:
150
151
  tot_blc_count(1:nspec)=tot_blc_count(1:nspec)+blc_count(1:nspec)
  tot_inc_count(1:nspec)=tot_inc_count(1:nspec)+inc_count(1:nspec)
152

Matthias Langer's avatar
 
Matthias Langer committed
153
end subroutine wetdepo