source: LMDZ6/trunk/libf/phylmd/Dust/trconvect.f90 @ 5301

Last change on this file since 5301 was 5292, checked in by abarral, 4 days ago

Move academic.h chem.h chem_spla.h to module

File size: 3.2 KB
Line 
1! Subroutine that computes the convective mixing and transport
2SUBROUTINE trconvect(pplay,t_seri,pdtphys,pmfu,pmfd,pen_u,pde_u, &
3        pen_d,pde_d,paprs,zdz,xconv,qmin,qmax,lminmax,masse, &
4        dtrconv,tr_seri)
5
6USE chem_mod_h
7    USE dimphy
8  USE infotrac
9  USE indice_sol_mod
10
11  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
12USE paramet_mod_h
13USE yomcst_mod_h
14IMPLICIT NONE
15
16
17
18
19
20  !============================= INPUT ===================================
21  REAL :: qmin, qmax
22  REAL :: xconv(nbtr), masse(nbtr)
23  REAL :: pplay(klon,klev)    ! pression pour le mileu de chaque couche (en Pa)
24  REAL :: t_seri(klon,klev)   ! temperature
25  REAL :: zdz(klon,klev)      ! zdz
26  REAL :: paprs(klon,klev+1)  ! pression pour chaque inter-couche (en Pa)
27  REAL :: pmfu(klon,klev)     ! flux de masse dans le panache montant
28  REAL :: pmfd(klon,klev)     ! flux de masse dans le panache descendant
29  REAL :: pen_u(klon,klev)    ! flux entraine dans le panache montant
30  REAL :: pde_u(klon,klev)    ! flux detraine dans le panache montant
31  REAL :: pen_d(klon,klev)    ! flux entraine dans le panache descendant
32  REAL :: pde_d(klon,klev)    ! flux detraine dans le panache descendant
33  LOGICAL :: lminmax
34  REAL :: pdtphys
35  !============================= OUTPUT ==================================
36  REAL :: aux_var1(klon,klev)
37  REAL :: aux_var2(klon,klev)
38  REAL :: tr_seri(klon,klev,nbtr) ! traceur
39  REAL :: dtrconv(klon,nbtr) ! traceur
40  !========================= LOCAL VARIABLES =============================
41  INTEGER :: it, k, i, j
42  REAL :: d_tr(klon,klev,nbtr)
43
44  EXTERNAL nflxtr, tiedqneg, minmaxqfi
45
46  DO it=1, nbtr
47  !
48  DO i=1, klon
49    dtrconv(i,it)=0.0
50  ENDDO
51  DO i=1,klon
52  DO j=1,klev
53    aux_var1(i,j)=tr_seri(i,j,it)
54    aux_var2(i,j)=d_tr(i,j,it)
55  ENDDO
56  ENDDO
57
58  !
59  !nhl      CALL nflxtr(pdtphys, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
60  !nhl     .            pplay, paprs, tr_seri(1,1,it), d_tr(1,1,it) )
61  CALL nflxtr(pdtphys, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
62        pplay, paprs, aux_var1, aux_var2 )
63  !
64  CALL tiedqneg(paprs,aux_var1, aux_var2)
65  !nhl      CALL tiedqneg(paprs,tr_seri(1,1,it), d_tr(1,1,it))
66  DO i=1,klon
67  DO j=1,klev
68    tr_seri(i,j,it)=aux_var1(i,j)
69    d_tr(i,j,it)=aux_var2(i,j)
70  ENDDO
71  ENDDO
72  !
73  DO k = 1, klev
74  DO i = 1, klon
75    IF (d_tr(i,k,it).LT.0.) THEN
76      tr_seri(i,k,it)=tr_seri(i,k,it)+d_tr(i,k,it)
77    ELSE
78      tr_seri(i,k,it)=tr_seri(i,k,it)+d_tr(i,k,it)*xconv(it)
79    ENDIF
80  ENDDO
81  ENDDO
82  !
83  !nhl      CALL kg_to_cm3(pplay,t_seri,d_tr(1,1,it))
84  CALL kg_to_cm3(pplay,t_seri,aux_var2)
85  DO i=1,klon
86  DO j=1,klev
87    d_tr(i,j,it)=aux_var2(i,j)
88  ENDDO
89  ENDDO
90
91  DO k = 1, klev
92  DO i = 1, klon
93    IF (d_tr(i,k,it).GE.0.) THEN
94    dtrconv(i,it)=dtrconv(i,it)+(1.-xconv(it))*d_tr(i,k,it) &
95          /RNAVO*masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys
96    ENDIF
97  ENDDO
98  ENDDO
99
100  IF (lminmax) THEN
101    DO i=1,klon
102    DO j=1,klev
103      aux_var1(i,j)=tr_seri(i,j,it)
104    ENDDO
105    ENDDO
106    CALL minmaxqfi(aux_var1,qmin,qmax,'apr convection')
107  !nhl      CALL minmaxqfi(tr_seri(1,1,it),qmin,qmax,'apr convection')
108    DO i=1,klon
109    DO j=1,klev
110      tr_seri(i,j,it)=aux_var1(i,j)
111    ENDDO
112    ENDDO
113  ENDIF
114  !
115  ENDDO
116
117END SUBROUTINE trconvect
Note: See TracBrowser for help on using the repository browser.