source: LMDZ6/trunk/libf/phylmd/Dust/incloud_scav_lsc.F @ 5134

Last change on this file since 5134 was 4593, checked in by yann meurdesoif, 18 months ago

Replace #include (c preprocessor) by INCLUDE (fortran keyword)

in phylmd (except rrtm and ecrad) filtrez, dy3dmem and dyn3dcommon

Other directories will follow
YM

File size: 3.6 KB
RevLine 
[2630]1c Subroutine that calculates the effect of precipitation in scavenging
2c WITHIN the cloud, for large scale as well as convective precipitation
3      SUBROUTINE incloud_scav_lsc(lminmax,qmin,qmax,masse,henry,kk,prfl,
4     .                      psfl,pmflxr,pmflxs,zrho,zdz,t_seri,pdtphys,
5     .                                   his_dhlsc,his_dhcon1,tr_seri)
6
7      USE dimphy
8      USE infotrac
9      USE indice_sol_mod
10
11      IMPLICIT NONE
12
[4593]13      INCLUDE "dimensions.h"
14      INCLUDE "chem.h"
15      INCLUDE "YOMCST.h"
16      INCLUDE "paramet.h"
[2630]17
18c============================= INPUT ===================================
19      REAL qmin, qmax
20      REAL masse(nbtr)
21      REAL henry(nbtr)         !--cste de Henry  mol/l/atm
22      REAL kk(nbtr)            !--coefficient de var avec T (K)
23      REAL prfl(klon,klev+1),   psfl(klon,klev+1)     !--large-scale
24!      REAL prfl(klon,klev),   psfl(klon,klev)     !--large-scale
25      REAL pmflxr(klon,klev+1), pmflxs(klon,klev+1)   !--convection
26!      REAL pmflxr(klon,klev), pmflxs(klon,klev)   !--convection
27      REAL zrho(klon,klev), zdz(klon,klev)
28      REAL t_seri(klon,klev)
29      LOGICAL lminmax
30      REAL pdtphys
31!      REAL prfl(klon,klev+1),   psfl(klon,klev+1)     !--large-scale  ! Titane
32!      REAL pmflxr(klon,klev+1), pmflxs(klon,klev+1)   !--convection   ! Titane
33c============================= OUTPUT ==================================
34      REAL tr_seri(klon,klev,nbtr) ! traceur
35      REAL aux_var1(klon,klev) ! traceur
36      REAL aux_var2(klon) ! traceur
37      REAL aux_var3(klon) ! traceur
38      REAL his_dhlsc(klon,nbtr)        ! in-cloud scavenging lsc
39      REAL his_dhcon1(klon,nbtr)       ! in-cloud scavenging con
40c========================= LOCAL VARIABLES =============================     
41      INTEGER it, i, j
42     
43      EXTERNAL minmaxqfi, inscav_spl
44      DO it=1, nbtr
45c
46      DO i=1,klon
47        aux_var2(i)=his_dhlsc(i,it)
48        aux_var3(i)=his_dhcon1(i,it)
49      ENDDO
50      DO j=1,klev
51      DO i=1,klon
52        aux_var1(i,j)=tr_seri(i,j,it)
53      ENDDO
54      ENDDO
55c     
56      IF (lminmax) THEN
57        CALL minmaxqfi(aux_var1,qmin,qmax,'avt inscav')
58cnhl      CALL minmaxqfi(tr_seri(1,1,it),qmin,qmax,'avt inscav')
59      ENDIF
60c
61cnhl      CALL inscav_spl(pdtphys,it,masse(it),henry(it),kk(it),0.5e-3,
62cnhl     .             prfl,psfl,zrho,zdz,t_seri,tr_seri(1,1,it),
63cnhl     .             his_dhlsc(1,it))
64      CALL inscav_spl(pdtphys,it,masse(it),henry(it),kk(it),0.5e-3,
65     .             prfl,psfl,zrho,zdz,t_seri,aux_var1,aux_var2)
66c
67      IF (lminmax) THEN
68        CALL minmaxqfi(aux_var1,qmin,qmax,'depot humide lsc')
69cnhl      CALL minmaxqfi(tr_seri(1,1,it),qmin,qmax,'depot humide lsc')
70      ENDIF
71c
72c
73c-scheme for convective in-cloud scavenging
74c
75cnhl      CALL inscav_spl(pdtphys,it,masse(it),henry(it),kk(it),1.e-3,
76cnhl     .             pmflxr,pmflxs,zrho,zdz,t_seri,tr_seri(1,1,it),
77cnhl     .             his_dhcon1(1,it))
78
79c      print *,'JE inscav0'
80c      IF (iflag_con.LT.3) THEN
81c
82c      print *,'JE inscav1'
83c      print *,'iflag_con',iflag_con
84c      CALL inscav_spl(pdtphys,it,masse(it),henry(it),kk(it),1.e-3,
85c     .             pmflxr,pmflxs,zrho,zdz,t_seri,aux_var1,aux_var3)
86c
87cc
88c      IF (lminmax) THEN
89c        CALL minmaxqfi(aux_var1,qmin,qmax,'depot humide con')
90ccnhl      CALL minmaxqfi(tr_seri(1,1,it),qmin,qmax,'depot humide con')
91c
92c      ENDIF
93c
94c      ENDIF ! iflag_con
95
96c
97c      print *,'JE inscav2'
98      DO j=1,klev
99      DO i=1,klon
100        tr_seri(i,j,it)=aux_var1(i,j)
101      ENDDO
102      ENDDO
103      DO i=1,klon
104        his_dhlsc(i,it)=aux_var2(i)
105        his_dhcon1(i,it)=aux_var3(i)
106      ENDDO
107
108c
109      ENDDO !--boucle sur it
110
111c      print *,'JE inscav3'
112      END
Note: See TracBrowser for help on using the repository browser.