Line data Source code
1 : ! Include shortname defintions, so that the F77 code does not have to be modified to
2 : ! reference the CARMA structure.
3 : #include "carma_globaer.h"
4 :
5 : !! This routine drives the vertical transport calculations.
6 : !!
7 : !! NOTE: Since this is only for sedimentation and brownian diffusion of a column within
8 : !! a parent model, the advection of air density, gases and potential temperature have
9 : !! been removed. Also, the divergence corrections (divcor) for 1D transport are not
10 : !! applied, since these columns exist within a parent model that is responsible for the
11 : !! advection.
12 : !!
13 : !! @author Eric Jensen
14 : !! version Mar-1995
15 1050624 : subroutine vertical(carma, cstate, rc)
16 :
17 : ! types
18 : use carma_precision_mod
19 : use carma_enums_mod
20 : use carma_constants_mod
21 : use carma_types_mod
22 : use carmastate_mod
23 : use carma_mod
24 :
25 : implicit none
26 :
27 : type(carma_type), intent(in) :: carma !! the carma object
28 : type(carmastate_type), intent(inout) :: cstate !! the carma state object
29 : integer, intent(inout) :: rc !! return code, negative indicates failure
30 :
31 : ! Declare local variables
32 : integer :: ielem
33 : integer :: ibin
34 : integer :: ig
35 2101248 : real(kind=f) :: vertadvu(NZP1)
36 2101248 : real(kind=f) :: vertadvd(NZP1)
37 2101248 : real(kind=f) :: vertdifu(NZP1)
38 2101248 : real(kind=f) :: vertdifd(NZP1)
39 2101248 : real(kind=f) :: vtrans(NZP1)
40 2101248 : real(kind=f) :: old_pc(NZ, NBIN, NELEM)
41 :
42 1050624 : rc = RC_OK
43 :
44 : ! Before doing advection, make sure that there are no negative values for
45 : ! the concentration element.
46 1050624 : call fixcorecol(carma, cstate, rc)
47 1050624 : if (rc < RC_OK) return
48 :
49 10451607552 : old_pc(:,:,:) = pc(:,:,:)
50 155492352 : sedimentationflux(:,:) = 0._f
51 :
52 8404992 : do ielem = 1,NELEM ! Loop over particle elements
53 7354368 : ig = igelem(ielem) ! particle group
54 :
55 : ! Should this group participate in sedimentation?
56 8404992 : if (grp_do_vtran(ig)) then
57 :
58 : ! Are there enough particles in the column to bother?
59 529514496 : if (maxval(pconmax(:,ig)) .gt. FEW_PC) then
60 :
61 153272595 : do ibin = 1,NBIN ! Loop over particle mass bins
62 10510120800 : vtrans(:) = -vf(:,ibin,ig)
63 :
64 : ! If dry deposition is enabled for this group, then set
65 : ! the deposition velocity at the surface.
66 145973900 : if (grp_do_drydep(ig)) then
67 145973900 : if (igridv .eq. I_CART) then
68 0 : vtrans(1) = -vd(ibin, ig)
69 : else
70 145973900 : vtrans(NZP1) = -vd(ibin, ig)
71 : end if
72 : end if
73 :
74 : ! Calculate particle transport rates due to vertical advection
75 : ! and vertical diffusion, and solve for concentrations at end of time step.
76 : call vertadv(carma, cstate, vtrans, pc(:,ibin,ielem), itbnd_pc, ibbnd_pc, &
77 145973900 : pc_topbnd(ibin,ielem), pc_botbnd(ibin,ielem), vertadvu, vertadvd, rc)
78 145973900 : if (rc < RC_OK) return
79 :
80 145973900 : call vertdif(carma, cstate, ig, ibin, itbnd_pc, ibbnd_pc, vertdifu, vertdifd, rc)
81 145973900 : if (rc < RC_OK) return
82 :
83 : ! There are 2 different solvers, versol with uses a PPM scheme and versub
84 : ! which using an explicit substepping approach.
85 153272595 : if (do_explised) then
86 0 : call versub(carma, cstate, pconmax(:,ig)*zmet(:), pc(:,ibin,ielem), itbnd_pc, ibbnd_pc, &
87 0 : ftoppart(ibin,ielem), fbotpart(ibin,ielem), &
88 0 : pc_topbnd(ibin,ielem), pc_botbnd(ibin,ielem), &
89 0 : vertadvu, vertadvd, vertdifu, vertdifd, rc)
90 0 : if (rc < RC_OK) return
91 : else
92 : call versol(carma, cstate, pc(:,ibin,ielem), itbnd_pc, ibbnd_pc, &
93 0 : ftoppart(ibin,ielem), fbotpart(ibin,ielem), &
94 0 : pc_topbnd(ibin,ielem), pc_botbnd(ibin,ielem), &
95 145973900 : vertadvu, vertadvd, vertdifu, vertdifd, rc)
96 145973900 : if (rc < RC_OK) return
97 : end if
98 : end do
99 : endif
100 : endif
101 : enddo ! ielem
102 :
103 :
104 : ! Advection can cause errors in tracer/tracer relationship that can cause
105 : ! negative values for the concentration element. Use a mass conserving
106 : ! fixer to make sure there are no negative values.
107 1050624 : call fixcorecol(carma, cstate, rc)
108 1050624 : if (rc < RC_OK) return
109 :
110 :
111 : ! Now the the column has been fixed up, look to see how much mass
112 : ! has been lost to the surface.
113 8404992 : do ielem = 1,NELEM ! Loop over particle elements
114 7354368 : ig = igelem(ielem) ! particle group
115 :
116 : ! Should this group participate in sedimentation?
117 8404992 : if (grp_do_vtran(ig)) then
118 :
119 154441728 : do ibin = 1,NBIN ! Loop over particle mass bins
120 :
121 : ! A clunky way to get the mass flux to the surface and to conserve mass
122 : ! is to determine the total before and after. Anything lost went to the
123 : ! surface.
124 : !
125 : ! NOTE: This only works if you assume nothing is lost out the top. It would be
126 : ! better to figure out how to get this directly from versol.
127 294174720 : pc_surf(ibin,ielem) = pc_surf(ibin, ielem) + max(0.0_f,sum(old_pc(:,ibin,ielem) * dz(:) ) - &
128 21033492480 : sum(pc(:,ibin,ielem) * dz(:) ))
129 0 : sedimentationflux(ibin,ielem) = ( max(0.0_f,sum(old_pc(:,ibin,ielem) * dz(:) ) - &
130 20746672128 : sum(pc(:,ibin,ielem) * dz(:) ) ) ) / dtime
131 : enddo ! ibin
132 : end if
133 : end do
134 :
135 :
136 : ! Return to caller with new particle concentrations.
137 : return
138 1050624 : end
|
