/[lmdze]/trunk/Sources/phylmd/nflxtr.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/nflxtr.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/libf/phylmd/nflxtr.f revision 7 by guez, Mon Mar 31 12:24:17 2008 UTC trunk/phylmd/nflxtr.f90 revision 76 by guez, Fri Nov 15 18:45:49 2013 UTC
# Line 1  Line 1 
1  !  SUBROUTINE nflxtr(pdtime,pmfu,pmfd,pen_u,pde_u,pen_d,pde_d, &
2  ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/nflxtr.F,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $       paprs,x,dx)
3  !  
4        SUBROUTINE nflxtr(pdtime,pmfu,pmfd,pen_u,pde_u,pen_d,pde_d,    ! From LMDZ4/libf/phylmd/nflxtr.F,v 1.1.1.1 2004/05/19 12:53:08
5       .                 pplay,paprs,x,dx)  
6        use dimens_m    USE dimphy, ONLY: klev, klon
7        use dimphy    USE suphec_m, ONLY: rg
8        use YOMCST  
9        IMPLICIT NONE    IMPLICIT NONE
10  c=====================================================================    !=====================================================================
11  c Objet : Melange convectif de traceurs a partir des flux de masse    ! Objet : Melange convectif de traceurs a partir des flux de masse
12  c Date : 13/12/1996 -- 13/01/97    ! Date : 13/12/1996 -- 13/01/97
13  c Auteur: O. Boucher (LOA) sur inspiration de Z. X. Li (LMD),    ! Auteur: O. Boucher (LOA) sur inspiration de Z. X. Li (LMD),
14  c         Brinkop et Sausen (1996) et Boucher et al. (1996).    !         Brinkop et Sausen (1996) et Boucher et al. (1996).
15  c ATTENTION : meme si cette routine se veut la plus generale possible,    ! ATTENTION : meme si cette routine se veut la plus generale possible,
16  c             elle a herite de certaines notations et conventions du    !             elle a herite de certaines notations et conventions du
17  c             schema de Tiedtke (1993).    !             schema de Tiedtke (1993).
18  c --En particulier, les couches sont numerotees de haut en bas !!!    ! --En particulier, les couches sont numerotees de haut en bas !!!
19  c   Ceci est valable pour les flux    !   Ceci est valable pour les flux
20  c   mais pas pour les entrees x, pplay, paprs !!!!    !   mais pas pour les entrees x, paprs !!!!
21  c --pmfu est positif, pmfd est negatif    ! --pmfu est positif, pmfd est negatif
22  c --Tous les flux d'entrainements et de detrainements sont positifs    ! --Tous les flux d'entrainements et de detrainements sont positifs
23  c   contrairement au schema de Tiedtke d'ou les changements de signe!!!!    !   contrairement au schema de Tiedtke d'ou les changements de signe!!!!
24  c=====================================================================    !=====================================================================
25  c    !
26        include "YOECUMF.h"    !
27  c    REAL, intent(in):: pdtime
28        REAL, intent(in):: pdtime    !--les flux sont definis au 1/2 niveaux
29  c--les flux sont definis au 1/2 niveaux    !--pmfu(klev+1) et pmfd(klev+1) sont implicitement nuls
30  c--pmfu(klev+1) et pmfd(klev+1) sont implicitement nuls  
31        REAL pmfu(klon,klev)  ! flux de masse dans le panache montant    REAL, intent(in):: pmfu(klon,klev)
32        REAL pmfd(klon,klev)  ! flux de masse dans le panache descendant    !     flux de masse dans le panache montant
33        REAL pen_u(klon,klev) ! flux entraine dans le panache montant  
34        REAL pde_u(klon,klev) ! flux detraine dans le panache montant    REAL, intent(in):: pmfd(klon,klev)  ! flux de masse dans le panache descendant
35        REAL pen_d(klon,klev) ! flux entraine dans le panache descendant    REAL pen_u(klon,klev) ! flux entraine dans le panache montant
36        REAL pde_d(klon,klev) ! flux detraine dans le panache descendant    REAL pde_u(klon,klev) ! flux detraine dans le panache montant
37      REAL pen_d(klon,klev) ! flux entraine dans le panache descendant
38        REAL pplay(klon,klev)    ! pression aux couches (bas en haut)    REAL pde_d(klon,klev) ! flux detraine dans le panache descendant
39        REAL, intent(in):: paprs(klon,klev+1) ! pression aux 1/2 couches (bas en haut)  
40        REAL, intent(in):: x(klon,klev)        ! q de traceur (bas en haut)    REAL, intent(in):: paprs(klon,klev+1) ! pression aux 1/2 couches (bas en haut)
41        REAL dx(klon,klev)     ! tendance de traceur  (bas en haut)    REAL, intent(in):: x(klon,klev)        ! q de traceur (bas en haut)
42  c    REAL dx(klon,klev)     ! tendance de traceur  (bas en haut)
43  c--flux convectifs mais en variables locales    !
44        REAL zmfu(klon,klev+1)    !--flux convectifs mais en variables locales
45        REAL zmfd(klon,klev+1)    REAL zmfu(klon,klev+1)
46        REAL zen_u(klon,klev)    REAL zmfd(klon,klev+1)
47        REAL zde_u(klon,klev)    REAL zen_u(klon,klev)
48        REAL zen_d(klon,klev)    REAL zde_u(klon,klev)
49        REAL zde_d(klon,klev)    REAL zen_d(klon,klev)
50        real zmfe    REAL zde_d(klon,klev)
51  c    real zmfe
52  c--variables locales          !
53  c--les flux de x sont definis aux 1/2 niveaux    !--variables locales      
54  c--xu et xd sont definis aux niveaux complets    !--les flux de x sont definis aux 1/2 niveaux
55        REAL xu(klon,klev)        ! q de traceurs dans le panache montant    !--xu et xd sont definis aux niveaux complets
56        REAL xd(klon,klev)        ! q de traceurs dans le panache descendant    REAL xu(klon,klev)        ! q de traceurs dans le panache montant
57        REAL zmfux(klon,klev+1)   ! flux de x dans le panache montant    REAL xd(klon,klev)        ! q de traceurs dans le panache descendant
58        REAL zmfdx(klon,klev+1)   ! flux de x dans le panache descendant    REAL zmfux(klon,klev+1)   ! flux de x dans le panache montant
59        REAL zmfex(klon,klev+1)   ! flux de x dans l'environnement    REAL zmfdx(klon,klev+1)   ! flux de x dans le panache descendant
60        INTEGER i, k    REAL zmfex(klon,klev+1)   ! flux de x dans l'environnement
61        REAL zmfmin    INTEGER i, k
62        PARAMETER (zmfmin=1.E-10)    REAL zmfmin
63      PARAMETER (zmfmin=1.E-10)
64  c =========================================  
65  c    ! =========================================
66  c    !
67  c   Extension des flux UP et DN sur klev+1 niveaux    !
68  c =========================================    !   Extension des flux UP et DN sur klev+1 niveaux
69        do k=1,klev    ! =========================================
70           do i=1,klon    do k=1,klev
71              zmfu(i,k)=pmfu(i,k)       do i=1,klon
72              zmfd(i,k)=pmfd(i,k)          zmfu(i,k)=pmfu(i,k)
73           enddo          zmfd(i,k)=pmfd(i,k)
74        enddo       enddo
75        do i=1,klon    enddo
76           zmfu(i,klev+1)=0.    do i=1,klon
77           zmfd(i,klev+1)=0.       zmfu(i,klev+1)=0.
78        enddo       zmfd(i,klev+1)=0.
79      enddo
80  c--modif pour diagnostiquer les detrainements  
81  c =========================================    !--modif pour diagnostiquer les detrainements
82  c   on privilegie l'ajustement de l'entrainement dans l'ascendance.    ! =========================================
83      !   on privilegie l'ajustement de l'entrainement dans l'ascendance.
84        do k=1, klev  
85           do i=1, klon    do k=1, klev
86              zen_d(i,k)=pen_d(i,k)       do i=1, klon
87              zde_u(i,k)=pde_u(i,k)          zen_d(i,k)=pen_d(i,k)
88              zde_d(i,k) =-zmfd(i,k+1)+zmfd(i,k)+zen_d(i,k)          zde_u(i,k)=pde_u(i,k)
89              zen_u(i,k) = zmfu(i,k+1)-zmfu(i,k)+zde_u(i,k)          zde_d(i,k) =-zmfd(i,k+1)+zmfd(i,k)+zen_d(i,k)
90           enddo          zen_u(i,k) = zmfu(i,k+1)-zmfu(i,k)+zde_u(i,k)
91        enddo       enddo
92  c    enddo
93  c--calcul des flux dans le panache montant    !
94  c =========================================    !--calcul des flux dans le panache montant
95  c    ! =========================================
96  c Dans la premiere couche, on prend q comme valeur de qu    !
97  c    ! Dans la premiere couche, on prend q comme valeur de qu
98        do i=1, klon    !
99           zmfux(i,1)=0.0    do i=1, klon
100        enddo       zmfux(i,1)=0.0
101  c    enddo
102  c Autres couches    !
103        do k=1,klev    ! Autres couches
104           do i=1, klon    do k=1,klev
105              if ((zmfu(i,k+1)+zde_u(i,k)).lt.zmfmin) THEN       do i=1, klon
106                 xu(i,k)=x(i,k)          if ((zmfu(i,k+1)+zde_u(i,k)).lt.zmfmin) THEN
107              else             xu(i,k)=x(i,k)
108                 xu(i,k)=(zmfux(i,k)+zen_u(i,k)*x(i,k))          else
109       s               /(zmfu(i,k+1)+zde_u(i,k))             xu(i,k)=(zmfux(i,k)+zen_u(i,k)*x(i,k)) &
110              endif                  /(zmfu(i,k+1)+zde_u(i,k))
111              zmfux(i,k+1)=zmfu(i,k+1)*xu(i,k)          endif
112           enddo          zmfux(i,k+1)=zmfu(i,k+1)*xu(i,k)
113        enddo       enddo
114  c    enddo
115  c--calcul des flux dans le panache descendant    !
116  c =========================================    !--calcul des flux dans le panache descendant
117  c      ! =========================================
118        do i=1, klon    !  
119           zmfdx(i,klev+1)=0.0    do i=1, klon
120        enddo       zmfdx(i,klev+1)=0.0
121  c    enddo
122        do k=klev,1,-1    !
123           do i=1, klon    do k=klev,1,-1
124              if ((zde_d(i,k)-zmfd(i,k)).lt.zmfmin) THEN       do i=1, klon
125                 xd(i,k)=x(i,k)          if ((zde_d(i,k)-zmfd(i,k)).lt.zmfmin) THEN
126              else             xd(i,k)=x(i,k)
127                 xd(i,k)=(zmfdx(i,k+1)-zen_d(i,k)*x(i,k)) /          else
128       .               (zmfd(i,k)-zde_d(i,k))             xd(i,k)=(zmfdx(i,k+1)-zen_d(i,k)*x(i,k)) / &
129              endif                  (zmfd(i,k)-zde_d(i,k))
130              zmfdx(i,k)=zmfd(i,k)*xd(i,k)          endif
131           enddo          zmfdx(i,k)=zmfd(i,k)*xd(i,k)
132        enddo       enddo
133  c    enddo
134  c--introduction du flux de retour dans l'environnement    !
135  c =========================================    !--introduction du flux de retour dans l'environnement
136  c    ! =========================================
137        do k=2, klev    !
138           do i=1, klon    do k=2, klev
139              zmfe=-zmfu(i,k)-zmfd(i,k)       do i=1, klon
140              if (zmfe.le.0.) then          zmfe=-zmfu(i,k)-zmfd(i,k)
141                 zmfex(i,k)= zmfe*x(i,k)          if (zmfe.le.0.) then
142              else             zmfex(i,k)= zmfe*x(i,k)
143                 zmfex(i,k)= zmfe*x(i,k-1)          else
144              endif             zmfex(i,k)= zmfe*x(i,k-1)
145           enddo          endif
146        enddo       enddo
147      enddo
148        do i=1, klon  
149           zmfex(i,1)=0.    do i=1, klon
150           zmfex(i,klev+1)=0.       zmfex(i,1)=0.
151        enddo       zmfex(i,klev+1)=0.
152  c    enddo
153  c--calcul final des tendances    !
154  c    !--calcul final des tendances
155        do k=1, klev    !
156           do i=1, klon    do k=1, klev
157              dx(i,k)=RG/(paprs(i,k)-paprs(i,k+1))*pdtime*       do i=1, klon
158       .                      ( zmfux(i,k) - zmfux(i,k+1) +          dx(i,k)=RG/(paprs(i,k)-paprs(i,k+1))*pdtime* &
159       .                        zmfdx(i,k) - zmfdx(i,k+1) +               ( zmfux(i,k) - zmfux(i,k+1) + &
160       .                        zmfex(i,k) - zmfex(i,k+1) )               zmfdx(i,k) - zmfdx(i,k+1) + &
161           enddo               zmfex(i,k) - zmfex(i,k+1) )
162        enddo       enddo
163  c    enddo
164        return  
165        end  end SUBROUTINE nflxtr

Legend:
Removed from v.7  
changed lines
  Added in v.76

  ViewVC Help
Powered by ViewVC 1.1.21