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

Last change on this file since 5182 was 5182, checked in by abarral, 2 months ago

(WIP) Replace REPROBUS CPP KEY by logical
properly name modules

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 lmdz_infotrac
10  USE lmdz_yomcst
11
12  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
13  USE lmdz_paramet
14  USE lmdz_chem, ONLY: idms, iso2, iso4, ih2s, idmso, imsa, ih2o2, &
15          n_avogadro, masse_s, masse_so4, rho_water, rho_ice
16  IMPLICIT NONE
17
18  !============================= INPUT ===================================
19  REAL :: qmin, qmax
20  REAL :: pdtphys  ! pas d'integration pour la physique (seconde)
21  ! REAL prfl(klon,klev),   psfl(klon,klev)     !--large-scale
22  ! REAL pmflxr(klon,klev), pmflxs(klon,klev)   !--convection
23  REAL :: alpha_r(nbtr)!--coefficient d'impaction pour la pluie
24  REAL :: alpha_s(nbtr)!--coefficient d'impaction pour la neige
25  REAL :: masse(nbtr)
26  LOGICAL :: lminmax
27  REAL :: zdz(klon, klev)
28  REAL :: prfl(klon, klev + 1), psfl(klon, klev + 1)     !--large-scale  ! Titane
29  REAL :: pmflxr(klon, klev + 1), pmflxs(klon, klev + 1)   !--convection   ! Titane
30  !============================= OUTPUT ==================================
31  REAL :: tr_seri(klon, klev, nbtr) ! traceur
32  REAL :: aux_var1(klon, klev) ! traceur
33  REAL :: aux_var2(klon, klev) ! traceur
34  REAL :: his_dhbclsc(klon, nbtr), his_dhbccon(klon, nbtr)
35  !========================= LOCAL VARIABLES =============================
36  INTEGER :: it, k, i, j
37  REAL :: d_tr(klon, klev, nbtr)
38
39  EXTERNAL minmaxqfi, bcscav_spl
40
41  DO it = 1, nbtr
42
43    DO j = 1, klev
44      DO i = 1, klon
45        aux_var1(i, j) = tr_seri(i, j, it)
46        aux_var2(i, j) = d_tr(i, j, it)
47      ENDDO
48    ENDDO
49
50    !nhl      CALL bcscav_spl(pdtphys,prfl,psfl,alpha_r(it),alpha_s(it),
51    !nhl     .                tr_seri(1,1,it),d_tr(1,1,it))
52    CALL bcscav_spl(pdtphys, prfl, psfl, alpha_r(it), alpha_s(it), &
53            aux_var1, aux_var2)
54
55    DO j = 1, klev
56      DO i = 1, klon
57        tr_seri(i, j, it) = aux_var1(i, j)
58        d_tr(i, j, it) = aux_var2(i, j)
59      ENDDO
60    ENDDO
61    DO k = 1, klev
62      DO i = 1, klon
63        tr_seri(i, k, it) = tr_seri(i, k, it) + d_tr(i, k, it)
64        his_dhbclsc(i, it) = his_dhbclsc(i, it) - d_tr(i, k, it) / RNAVO * &
65                masse(it) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys  !--mgS/m2/s
66
67      ENDDO
68    ENDDO
69
70    DO i = 1, klon
71      DO j = 1, klev
72        aux_var1(i, j) = tr_seri(i, j, it)
73        aux_var2(i, j) = d_tr(i, j, it)
74      ENDDO
75    ENDDO
76
77    IF (lminmax) THEN
78      CALL minmaxqfi(aux_var1, qmin, qmax, 'depot humide bc lsc')
79      !nhl      CALL minmaxqfi(tr_seri(1,1,it),qmin,qmax,'depot humide bc lsc')
80    ENDIF
81
82    !-scheme for convective scavenging
83
84    !nhl      CALL bcscav_spl(pdtphys,pmflxr,pmflxs,alpha_r(it),alpha_s(it),
85    !nhl     .                tr_seri(1,1,it),d_tr(1,1,it))
86
87
88    !JE      CALL bcscav_spl(pdtphys,pmflxr,pmflxs,alpha_r(it),alpha_s(it),
89    !JE     .                aux_var1,aux_var2)
90
91    DO i = 1, klon
92      DO j = 1, klev
93        tr_seri(i, j, it) = aux_var1(i, j)
94        d_tr(i, j, it) = aux_var2(i, j)
95      ENDDO
96    ENDDO
97
98    DO k = 1, klev
99      DO i = 1, klon
100        tr_seri(i, k, it) = tr_seri(i, k, it) + d_tr(i, k, it)
101        his_dhbccon(i, it) = his_dhbccon(i, it) - d_tr(i, k, it) / RNAVO * &
102                masse(it) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys    !--mgS/m2/s
103      ENDDO
104    ENDDO
105
106    IF (lminmax) THEN
107      DO j = 1, klev
108        DO i = 1, klon
109          aux_var1(i, j) = tr_seri(i, j, it)
110        ENDDO
111      ENDDO
112      CALL minmaxqfi(aux_var1, qmin, qmax, 'depot humide bc con')
113      !nhl      CALL minmaxqfi(tr_seri(1,1,it),qmin,qmax,'depot humide bc con')
114      DO j = 1, klev
115        DO i = 1, klon
116          tr_seri(i, j, it) = aux_var1(i, j)
117        ENDDO
118      ENDDO
119    ENDIF
120
121  ENDDO !--boucle sur it
122
123END SUBROUTINE blcloud_scav_lsc
Note: See TracBrowser for help on using the repository browser.