source: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/blcloud_scav_lsc.f90 @ 5119

Last change on this file since 5119 was 5104, checked in by abarral, 4 months ago

Replace 1DUTILS.h by module lmdz_1dutils.f90
Replace 1DConv.h by module lmdz_old_1dconv.f90 (it's only used by old_* files)
Convert *.F in DUST to *.f90

File size: 3.9 KB
Line 
1! Subroutine that calculates the effect of precipitation in scavenging
2! BELOW the cloud, for large scale as well as convective precipitation
3SUBROUTINE blcloud_scav_lsc(lminmax, qmin, qmax, pdtphys, prfl, psfl, &
4        pmflxr, pmflxs, zdz, alpha_r, alpha_s, masse, &
5        his_dhbclsc, his_dhbccon, tr_seri)
6
7  USE dimphy
8  USE indice_sol_mod
9  USE infotrac
10  IMPLICIT NONE
11
12  INCLUDE "dimensions.h"
13  INCLUDE "chem.h"
14  INCLUDE "YOMCST.h"
15  INCLUDE "paramet.h"
16
17  !============================= INPUT ===================================
18  REAL :: qmin, qmax
19  REAL :: pdtphys  ! pas d'integration pour la physique (seconde)
20  ! REAL prfl(klon,klev),   psfl(klon,klev)     !--large-scale
21  ! REAL pmflxr(klon,klev), pmflxs(klon,klev)   !--convection
22  REAL :: alpha_r(nbtr)!--coefficient d'impaction pour la pluie
23  REAL :: alpha_s(nbtr)!--coefficient d'impaction pour la neige
24  REAL :: masse(nbtr)
25  LOGICAL :: lminmax
26  REAL :: zdz(klon, klev)
27  REAL :: prfl(klon, klev + 1), psfl(klon, klev + 1)     !--large-scale  ! Titane
28  REAL :: pmflxr(klon, klev + 1), pmflxs(klon, klev + 1)   !--convection   ! Titane
29  !============================= OUTPUT ==================================
30  REAL :: tr_seri(klon, klev, nbtr) ! traceur
31  REAL :: aux_var1(klon, klev) ! traceur
32  REAL :: aux_var2(klon, klev) ! traceur
33  REAL :: his_dhbclsc(klon, nbtr), his_dhbccon(klon, nbtr)
34  !========================= LOCAL VARIABLES =============================
35  INTEGER :: it, k, i, j
36  REAL :: d_tr(klon, klev, nbtr)
37
38  EXTERNAL minmaxqfi, bcscav_spl
39
40  DO it = 1, nbtr
41    !
42    DO j = 1, klev
43      DO i = 1, klon
44        aux_var1(i, j) = tr_seri(i, j, it)
45        aux_var2(i, j) = d_tr(i, j, it)
46      ENDDO
47    ENDDO
48    !
49    !nhl      CALL bcscav_spl(pdtphys,prfl,psfl,alpha_r(it),alpha_s(it),
50    !nhl     .                tr_seri(1,1,it),d_tr(1,1,it))
51    CALL bcscav_spl(pdtphys, prfl, psfl, alpha_r(it), alpha_s(it), &
52            aux_var1, aux_var2)
53    !
54    DO j = 1, klev
55      DO i = 1, klon
56        tr_seri(i, j, it) = aux_var1(i, j)
57        d_tr(i, j, it) = aux_var2(i, j)
58      ENDDO
59    ENDDO
60    DO k = 1, klev
61      DO i = 1, klon
62        tr_seri(i, k, it) = tr_seri(i, k, it) + d_tr(i, k, it)
63        his_dhbclsc(i, it) = his_dhbclsc(i, it) - d_tr(i, k, it) / RNAVO * &
64                masse(it) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys  !--mgS/m2/s
65
66      ENDDO
67    ENDDO
68    !
69    DO i = 1, klon
70      DO j = 1, klev
71        aux_var1(i, j) = tr_seri(i, j, it)
72        aux_var2(i, j) = d_tr(i, j, it)
73      ENDDO
74    ENDDO
75    !
76    IF (lminmax) THEN
77      CALL minmaxqfi(aux_var1, qmin, qmax, 'depot humide bc lsc')
78      !nhl      CALL minmaxqfi(tr_seri(1,1,it),qmin,qmax,'depot humide bc lsc')
79    ENDIF
80    !
81    !-scheme for convective scavenging
82    !
83    !nhl      CALL bcscav_spl(pdtphys,pmflxr,pmflxs,alpha_r(it),alpha_s(it),
84    !nhl     .                tr_seri(1,1,it),d_tr(1,1,it))
85
86
87    !JE      CALL bcscav_spl(pdtphys,pmflxr,pmflxs,alpha_r(it),alpha_s(it),
88    !JE     .                aux_var1,aux_var2)
89
90
91    !
92    DO i = 1, klon
93      DO j = 1, klev
94        tr_seri(i, j, it) = aux_var1(i, j)
95        d_tr(i, j, it) = aux_var2(i, j)
96      ENDDO
97    ENDDO
98    !
99    DO k = 1, klev
100      DO i = 1, klon
101        tr_seri(i, k, it) = tr_seri(i, k, it) + d_tr(i, k, it)
102        his_dhbccon(i, it) = his_dhbccon(i, it) - d_tr(i, k, it) / RNAVO * &
103                masse(it) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys    !--mgS/m2/s
104      ENDDO
105    ENDDO
106    !
107    IF (lminmax) THEN
108      DO j = 1, klev
109        DO i = 1, klon
110          aux_var1(i, j) = tr_seri(i, j, it)
111        ENDDO
112      ENDDO
113      CALL minmaxqfi(aux_var1, qmin, qmax, 'depot humide bc con')
114      !nhl      CALL minmaxqfi(tr_seri(1,1,it),qmin,qmax,'depot humide bc con')
115      DO j = 1, klev
116        DO i = 1, klon
117          tr_seri(i, j, it) = aux_var1(i, j)
118        ENDDO
119      ENDDO
120    ENDIF
121    !
122    !
123  ENDDO !--boucle sur it
124  !
125END SUBROUTINE blcloud_scav_lsc
Note: See TracBrowser for help on using the repository browser.