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

Last change on this file since 5182 was 5182, checked in by abarral, 10 days ago

(WIP) Replace REPROBUS CPP KEY by logical
properly name modules

File size: 3.6 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
[5182]7  USE lmdz_infotrac
[5104]8  USE indice_sol_mod
[5144]9  USE lmdz_yomcst
[2630]10
[5159]11USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
12  USE lmdz_paramet
[5160]13USE lmdz_chem, ONLY: idms, iso2, iso4, ih2s, idmso, imsa, ih2o2, &
14          n_avogadro, masse_s, masse_so4, rho_water, rho_ice
[5104]15  IMPLICIT NONE
[2630]16
[5159]17
[2630]18
[5159]19
[5160]20
[5104]21  !============================= INPUT ===================================
22  REAL :: qmin, qmax
23  REAL :: xconv(nbtr), masse(nbtr)
24  REAL :: pplay(klon, klev)    ! pression pour le mileu de chaque couche (en Pa)
25  REAL :: t_seri(klon, klev)   ! temperature
26  REAL :: zdz(klon, klev)      ! zdz
27  REAL :: paprs(klon, klev + 1)  ! pression pour chaque inter-couche (en Pa)
28  REAL :: pmfu(klon, klev)     ! flux de masse dans le panache montant
29  REAL :: pmfd(klon, klev)     ! flux de masse dans le panache descendant
30  REAL :: pen_u(klon, klev)    ! flux entraine dans le panache montant
31  REAL :: pde_u(klon, klev)    ! flux detraine dans le panache montant
32  REAL :: pen_d(klon, klev)    ! flux entraine dans le panache descendant
33  REAL :: pde_d(klon, klev)    ! flux detraine dans le panache descendant
34  LOGICAL :: lminmax
35  REAL :: pdtphys
36  !============================= OUTPUT ==================================
37  REAL :: aux_var1(klon, klev)
38  REAL :: aux_var2(klon, klev)
39  REAL :: tr_seri(klon, klev, nbtr) ! traceur
40  REAL :: dtrconv(klon, nbtr) ! traceur
41  !========================= LOCAL VARIABLES =============================
42  INTEGER :: it, k, i, j
43  REAL :: d_tr(klon, klev, nbtr)
[2630]44
[5104]45  EXTERNAL nflxtr, tiedqneg, minmaxqfi
46
47  DO it = 1, nbtr
[5159]48
[5104]49    DO i = 1, klon
50      dtrconv(i, it) = 0.0
51    ENDDO
52    DO i = 1, klon
53      DO j = 1, klev
54        aux_var1(i, j) = tr_seri(i, j, it)
55        aux_var2(i, j) = d_tr(i, j, it)
[2630]56      ENDDO
[5104]57    ENDDO
58
[5159]59
[5104]60    !nhl      CALL nflxtr(pdtphys, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
61    !nhl     .            pplay, paprs, tr_seri(1,1,it), d_tr(1,1,it) )
62    CALL nflxtr(pdtphys, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
63            pplay, paprs, aux_var1, aux_var2)
[5159]64
[5104]65    CALL tiedqneg(paprs, aux_var1, aux_var2)
66    !nhl      CALL tiedqneg(paprs,tr_seri(1,1,it), d_tr(1,1,it))
67    DO i = 1, klon
68      DO j = 1, klev
69        tr_seri(i, j, it) = aux_var1(i, j)
70        d_tr(i, j, it) = aux_var2(i, j)
[2630]71      ENDDO
[5104]72    ENDDO
[5159]73
[5104]74    DO k = 1, klev
[2630]75      DO i = 1, klon
[5104]76        IF (d_tr(i, k, it)<0.) THEN
77          tr_seri(i, k, it) = tr_seri(i, k, it) + d_tr(i, k, it)
[2630]78        ELSE
[5104]79          tr_seri(i, k, it) = tr_seri(i, k, it) + d_tr(i, k, it) * xconv(it)
[2630]80        ENDIF
81      ENDDO
[5104]82    ENDDO
[5159]83
[5104]84    !nhl      CALL kg_to_cm3(pplay,t_seri,d_tr(1,1,it))
85    CALL kg_to_cm3(pplay, t_seri, aux_var2)
86    DO i = 1, klon
87      DO j = 1, klev
88        d_tr(i, j, it) = aux_var2(i, j)
[2630]89      ENDDO
[5104]90    ENDDO
[2630]91
[5104]92    DO k = 1, klev
[2630]93      DO i = 1, klon
[5104]94        IF (d_tr(i, k, it)>=0.) THEN
95          dtrconv(i, it) = dtrconv(i, it) + (1. - xconv(it)) * d_tr(i, k, it) &
96                  / RNAVO * masse(it) * 1.e3 * 1.e6 * zdz(i, k) / pdtphys
[2630]97        ENDIF
98      ENDDO
[5104]99    ENDDO
[2630]100
[5104]101    IF (lminmax) THEN
102      DO i = 1, klon
103        DO j = 1, klev
104          aux_var1(i, j) = tr_seri(i, j, it)
[2630]105        ENDDO
[5104]106      ENDDO
107      CALL minmaxqfi(aux_var1, qmin, qmax, 'apr convection')
108      !nhl      CALL minmaxqfi(tr_seri(1,1,it),qmin,qmax,'apr convection')
109      DO i = 1, klon
110        DO j = 1, klev
111          tr_seri(i, j, it) = aux_var1(i, j)
[2630]112        ENDDO
113      ENDDO
[5104]114    ENDIF
[5159]115
[5104]116  ENDDO
[2630]117
[5104]118END SUBROUTINE trconvect
Note: See TracBrowser for help on using the repository browser.