source: LMDZ6/trunk/libf/phylmd/Dust/blcloud_scav_lsc.f90 @ 5248

Last change on this file since 5248 was 5246, checked in by abarral, 6 weeks ago

Convert fixed-form to free-form sources .F -> .{f,F}90
(WIP: some .F remain, will be handled in subsequent commits)

File size: 3.5 KB
RevLine 
[5246]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)
[2630]6
[5246]7  USE dimphy
8  USE indice_sol_mod
9  USE infotrac
10  IMPLICIT NONE
[2630]11
[5246]12  INCLUDE "dimensions.h"
13  INCLUDE "chem.h"
14  INCLUDE "YOMCST.h"
15  INCLUDE "paramet.h"
[2630]16
[5246]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)
[2630]37
[5246]38  EXTERNAL minmaxqfi, bcscav_spl
[2630]39
[5246]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
[2630]65
[5246]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))
[2630]85
86
[5246]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.