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

Last change on this file since 5253 was 5246, checked in by abarral, 13 months 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.1 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
6  USE dimphy
7  USE infotrac
8  USE indice_sol_mod
9
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 :: xconv(nbtr), masse(nbtr)
20  REAL :: pplay(klon,klev)    ! pression pour le mileu de chaque couche (en Pa)
21  REAL :: t_seri(klon,klev)   ! temperature
22  REAL :: zdz(klon,klev)      ! zdz
23  REAL :: paprs(klon,klev+1)  ! pression pour chaque inter-couche (en Pa)
24  REAL :: pmfu(klon,klev)     ! flux de masse dans le panache montant
25  REAL :: pmfd(klon,klev)     ! flux de masse dans le panache descendant
26  REAL :: pen_u(klon,klev)    ! flux entraine dans le panache montant
27  REAL :: pde_u(klon,klev)    ! flux detraine dans le panache montant
28  REAL :: pen_d(klon,klev)    ! flux entraine dans le panache descendant
29  REAL :: pde_d(klon,klev)    ! flux detraine dans le panache descendant
30  LOGICAL :: lminmax
31  REAL :: pdtphys
32  !============================= OUTPUT ==================================
33  REAL :: aux_var1(klon,klev)
34  REAL :: aux_var2(klon,klev)
35  REAL :: tr_seri(klon,klev,nbtr) ! traceur
36  REAL :: dtrconv(klon,nbtr) ! traceur
37  !========================= LOCAL VARIABLES =============================
38  INTEGER :: it, k, i, j
39  REAL :: d_tr(klon,klev,nbtr)
40
41  EXTERNAL nflxtr, tiedqneg, minmaxqfi
42
43  DO it=1, nbtr
44  !
45  DO i=1, klon
46    dtrconv(i,it)=0.0
47  ENDDO
48  DO i=1,klon
49  DO j=1,klev
50    aux_var1(i,j)=tr_seri(i,j,it)
51    aux_var2(i,j)=d_tr(i,j,it)
52  ENDDO
53  ENDDO
54
55  !
56  !nhl      CALL nflxtr(pdtphys, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
57  !nhl     .            pplay, paprs, tr_seri(1,1,it), d_tr(1,1,it) )
58  CALL nflxtr(pdtphys, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
59        pplay, paprs, aux_var1, aux_var2 )
60  !
61  CALL tiedqneg(paprs,aux_var1, aux_var2)
62  !nhl      CALL tiedqneg(paprs,tr_seri(1,1,it), d_tr(1,1,it))
63  DO i=1,klon
64  DO j=1,klev
65    tr_seri(i,j,it)=aux_var1(i,j)
66    d_tr(i,j,it)=aux_var2(i,j)
67  ENDDO
68  ENDDO
69  !
70  DO k = 1, klev
71  DO i = 1, klon
72    IF (d_tr(i,k,it).LT.0.) THEN
73      tr_seri(i,k,it)=tr_seri(i,k,it)+d_tr(i,k,it)
74    ELSE
75      tr_seri(i,k,it)=tr_seri(i,k,it)+d_tr(i,k,it)*xconv(it)
76    ENDIF
77  ENDDO
78  ENDDO
79  !
80  !nhl      CALL kg_to_cm3(pplay,t_seri,d_tr(1,1,it))
81  CALL kg_to_cm3(pplay,t_seri,aux_var2)
82  DO i=1,klon
83  DO j=1,klev
84    d_tr(i,j,it)=aux_var2(i,j)
85  ENDDO
86  ENDDO
87
88  DO k = 1, klev
89  DO i = 1, klon
90    IF (d_tr(i,k,it).GE.0.) THEN
91    dtrconv(i,it)=dtrconv(i,it)+(1.-xconv(it))*d_tr(i,k,it) &
92          /RNAVO*masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys
93    ENDIF
94  ENDDO
95  ENDDO
96
97  IF (lminmax) THEN
98    DO i=1,klon
99    DO j=1,klev
100      aux_var1(i,j)=tr_seri(i,j,it)
101    ENDDO
102    ENDDO
103    CALL minmaxqfi(aux_var1,qmin,qmax,'apr convection')
104  !nhl      CALL minmaxqfi(tr_seri(1,1,it),qmin,qmax,'apr convection')
105    DO i=1,klon
106    DO j=1,klev
107      tr_seri(i,j,it)=aux_var1(i,j)
108    ENDDO
109    ENDDO
110  ENDIF
111  !
112  ENDDO
113
114END SUBROUTINE trconvect
Note: See TracBrowser for help on using the repository browser.