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

Diff of /trunk/phylmd/nflxtr.f

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

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

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

  ViewVC Help
Powered by ViewVC 1.1.21