source: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/trconvect.f90 @ 5113

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

Replace 1DUTILS.h by module lmdz_1dutils.f90
Replace 1DConv.h by module lmdz_old_1dconv.f90 (it's only used by old_* files)
Convert *.F in DUST to *.f90

File size: 3.5 KB
RevLine 
[5104]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)
[2630]5
[5104]6  USE dimphy
7  USE infotrac
8  USE indice_sol_mod
[2630]9
[5104]10  IMPLICIT NONE
[2630]11
[5104]12  INCLUDE "dimensions.h"
13  INCLUDE "chem.h"
14  INCLUDE "YOMCST.h"
15  INCLUDE "paramet.h"
[2630]16
[5104]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)
[2630]40
[5104]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)
[2630]52      ENDDO
[5104]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)
[2630]67      ENDDO
[5104]68    ENDDO
69    !
70    DO k = 1, klev
[2630]71      DO i = 1, klon
[5104]72        IF (d_tr(i, k, it)<0.) THEN
73          tr_seri(i, k, it) = tr_seri(i, k, it) + d_tr(i, k, it)
[2630]74        ELSE
[5104]75          tr_seri(i, k, it) = tr_seri(i, k, it) + d_tr(i, k, it) * xconv(it)
[2630]76        ENDIF
77      ENDDO
[5104]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)
[2630]85      ENDDO
[5104]86    ENDDO
[2630]87
[5104]88    DO k = 1, klev
[2630]89      DO i = 1, klon
[5104]90        IF (d_tr(i, k, it)>=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
[2630]93        ENDIF
94      ENDDO
[5104]95    ENDDO
[2630]96
[5104]97    IF (lminmax) THEN
98      DO i = 1, klon
99        DO j = 1, klev
100          aux_var1(i, j) = tr_seri(i, j, it)
[2630]101        ENDDO
[5104]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)
[2630]108        ENDDO
109      ENDDO
[5104]110    ENDIF
111    !
112  ENDDO
[2630]113
[5104]114END SUBROUTINE trconvect
Note: See TracBrowser for help on using the repository browser.