/[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 62 by guez, Thu Jul 26 14:37:37 2012 UTC trunk/libf/phylmd/nflxtr.f90 revision 63 by guez, Wed Aug 1 14:13:57 2012 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, intent(in):: pmfu(klon,klev)
32        REAL, intent(in):: pmfu(klon,klev)    !     flux de masse dans le panache montant
33  !     flux de masse dans le panache montant  
34      REAL pmfd(klon,klev)  ! flux de masse dans le panache descendant
35        REAL pmfd(klon,klev)  ! flux de masse dans le panache descendant    REAL pen_u(klon,klev) ! flux entraine dans le panache montant
36        REAL pen_u(klon,klev) ! flux entraine dans le panache montant    REAL pde_u(klon,klev) ! flux detraine dans le panache montant
37        REAL pde_u(klon,klev) ! flux detraine dans le panache montant    REAL pen_d(klon,klev) ! flux entraine dans le panache descendant
38        REAL pen_d(klon,klev) ! flux entraine dans le panache descendant    REAL pde_d(klon,klev) ! flux detraine dans le panache descendant
39        REAL pde_d(klon,klev) ! flux detraine dans le panache descendant  
40      REAL, intent(in):: paprs(klon,klev+1) ! pression aux 1/2 couches (bas en haut)
41        REAL, intent(in):: paprs(klon,klev+1) ! pression aux 1/2 couches (bas en haut)    REAL, intent(in):: x(klon,klev)        ! q de traceur (bas en haut)
42        REAL, intent(in):: x(klon,klev)        ! q de traceur (bas en haut)    REAL dx(klon,klev)     ! tendance de traceur  (bas en haut)
43        REAL dx(klon,klev)     ! tendance de traceur  (bas en haut)    !
44  c    !--flux convectifs mais en variables locales
45  c--flux convectifs mais en variables locales    REAL zmfu(klon,klev+1)
46        REAL zmfu(klon,klev+1)    REAL zmfd(klon,klev+1)
47        REAL zmfd(klon,klev+1)    REAL zen_u(klon,klev)
48        REAL zen_u(klon,klev)    REAL zde_u(klon,klev)
49        REAL zde_u(klon,klev)    REAL zen_d(klon,klev)
50        REAL zen_d(klon,klev)    REAL zde_d(klon,klev)
51        REAL zde_d(klon,klev)    real zmfe
52        real zmfe    !
53  c    !--variables locales      
54  c--variables locales          !--les flux de x sont definis aux 1/2 niveaux
55  c--les flux de x sont definis aux 1/2 niveaux    !--xu et xd sont definis aux niveaux complets
56  c--xu et xd sont definis aux niveaux complets    REAL xu(klon,klev)        ! q de traceurs dans le panache montant
57        REAL xu(klon,klev)        ! q de traceurs dans le panache montant    REAL xd(klon,klev)        ! q de traceurs dans le panache descendant
58        REAL xd(klon,klev)        ! q de traceurs dans le panache descendant    REAL zmfux(klon,klev+1)   ! flux de x dans le panache montant
59        REAL zmfux(klon,klev+1)   ! flux de x dans le panache montant    REAL zmfdx(klon,klev+1)   ! flux de x dans le panache descendant
60        REAL zmfdx(klon,klev+1)   ! flux de x dans le panache descendant    REAL zmfex(klon,klev+1)   ! flux de x dans l'environnement
61        REAL zmfex(klon,klev+1)   ! flux de x dans l'environnement    INTEGER i, k
62        INTEGER i, k    REAL zmfmin
63        REAL zmfmin    PARAMETER (zmfmin=1.E-10)
64        PARAMETER (zmfmin=1.E-10)  
65      ! =========================================
66  c =========================================    !
67  c    !
68  c    !   Extension des flux UP et DN sur klev+1 niveaux
69  c   Extension des flux UP et DN sur klev+1 niveaux    ! =========================================
70  c =========================================    do k=1,klev
71        do k=1,klev       do i=1,klon
72           do i=1,klon          zmfu(i,k)=pmfu(i,k)
73              zmfu(i,k)=pmfu(i,k)          zmfd(i,k)=pmfd(i,k)
74              zmfd(i,k)=pmfd(i,k)       enddo
75           enddo    enddo
76        enddo    do i=1,klon
77        do i=1,klon       zmfu(i,klev+1)=0.
78           zmfu(i,klev+1)=0.       zmfd(i,klev+1)=0.
79           zmfd(i,klev+1)=0.    enddo
80        enddo  
81      !--modif pour diagnostiquer les detrainements
82  c--modif pour diagnostiquer les detrainements    ! =========================================
83  c =========================================    !   on privilegie l'ajustement de l'entrainement dans l'ascendance.
84  c   on privilegie l'ajustement de l'entrainement dans l'ascendance.  
85      do k=1, klev
86        do k=1, klev       do i=1, klon
87           do i=1, klon          zen_d(i,k)=pen_d(i,k)
88              zen_d(i,k)=pen_d(i,k)          zde_u(i,k)=pde_u(i,k)
89              zde_u(i,k)=pde_u(i,k)          zde_d(i,k) =-zmfd(i,k+1)+zmfd(i,k)+zen_d(i,k)
90              zde_d(i,k) =-zmfd(i,k+1)+zmfd(i,k)+zen_d(i,k)          zen_u(i,k) = zmfu(i,k+1)-zmfu(i,k)+zde_u(i,k)
91              zen_u(i,k) = zmfu(i,k+1)-zmfu(i,k)+zde_u(i,k)       enddo
92           enddo    enddo
93        enddo    !
94  c    !--calcul des flux dans le panache montant
95  c--calcul des flux dans le panache montant    ! =========================================
96  c =========================================    !
97  c    ! Dans la premiere couche, on prend q comme valeur de qu
98  c Dans la premiere couche, on prend q comme valeur de qu    !
99  c    do i=1, klon
100        do i=1, klon       zmfux(i,1)=0.0
101           zmfux(i,1)=0.0    enddo
102        enddo    !
103  c    ! Autres couches
104  c Autres couches    do k=1,klev
105        do k=1,klev       do i=1, klon
106           do i=1, klon          if ((zmfu(i,k+1)+zde_u(i,k)).lt.zmfmin) THEN
107              if ((zmfu(i,k+1)+zde_u(i,k)).lt.zmfmin) THEN             xu(i,k)=x(i,k)
108                 xu(i,k)=x(i,k)          else
109              else             xu(i,k)=(zmfux(i,k)+zen_u(i,k)*x(i,k)) &
110                 xu(i,k)=(zmfux(i,k)+zen_u(i,k)*x(i,k))                  /(zmfu(i,k+1)+zde_u(i,k))
111       s               /(zmfu(i,k+1)+zde_u(i,k))          endif
112              endif          zmfux(i,k+1)=zmfu(i,k+1)*xu(i,k)
113              zmfux(i,k+1)=zmfu(i,k+1)*xu(i,k)       enddo
114           enddo    enddo
115        enddo    !
116  c    !--calcul des flux dans le panache descendant
117  c--calcul des flux dans le panache descendant    ! =========================================
118  c =========================================    !  
119  c      do i=1, klon
120        do i=1, klon       zmfdx(i,klev+1)=0.0
121           zmfdx(i,klev+1)=0.0    enddo
122        enddo    !
123  c    do k=klev,1,-1
124        do k=klev,1,-1       do i=1, klon
125           do i=1, klon          if ((zde_d(i,k)-zmfd(i,k)).lt.zmfmin) THEN
126              if ((zde_d(i,k)-zmfd(i,k)).lt.zmfmin) THEN             xd(i,k)=x(i,k)
127                 xd(i,k)=x(i,k)          else
128              else             xd(i,k)=(zmfdx(i,k+1)-zen_d(i,k)*x(i,k)) / &
129                 xd(i,k)=(zmfdx(i,k+1)-zen_d(i,k)*x(i,k)) /                  (zmfd(i,k)-zde_d(i,k))
130       .               (zmfd(i,k)-zde_d(i,k))          endif
131              endif          zmfdx(i,k)=zmfd(i,k)*xd(i,k)
132              zmfdx(i,k)=zmfd(i,k)*xd(i,k)       enddo
133           enddo    enddo
134        enddo    !
135  c    !--introduction du flux de retour dans l'environnement
136  c--introduction du flux de retour dans l'environnement    ! =========================================
137  c =========================================    !
138  c    do k=2, klev
139        do k=2, klev       do i=1, klon
140           do i=1, klon          zmfe=-zmfu(i,k)-zmfd(i,k)
141              zmfe=-zmfu(i,k)-zmfd(i,k)          if (zmfe.le.0.) then
142              if (zmfe.le.0.) then             zmfex(i,k)= zmfe*x(i,k)
143                 zmfex(i,k)= zmfe*x(i,k)          else
144              else             zmfex(i,k)= zmfe*x(i,k-1)
145                 zmfex(i,k)= zmfe*x(i,k-1)          endif
146              endif       enddo
147           enddo    enddo
148        enddo  
149      do i=1, klon
150        do i=1, klon       zmfex(i,1)=0.
151           zmfex(i,1)=0.       zmfex(i,klev+1)=0.
152           zmfex(i,klev+1)=0.    enddo
153        enddo    !
154  c    !--calcul final des tendances
155  c--calcul final des tendances    !
156  c    do k=1, klev
157        do k=1, klev       do i=1, klon
158           do i=1, klon          dx(i,k)=RG/(paprs(i,k)-paprs(i,k+1))*pdtime* &
159              dx(i,k)=RG/(paprs(i,k)-paprs(i,k+1))*pdtime*               ( zmfux(i,k) - zmfux(i,k+1) + &
160       .                      ( zmfux(i,k) - zmfux(i,k+1) +               zmfdx(i,k) - zmfdx(i,k+1) + &
161       .                        zmfdx(i,k) - zmfdx(i,k+1) +               zmfex(i,k) - zmfex(i,k+1) )
162       .                        zmfex(i,k) - zmfex(i,k+1) )       enddo
163           enddo    enddo
164        enddo  
165  c  end SUBROUTINE nflxtr
       return  
       end  
Legend:
Removed from v.62  
changed lines
  Added in v.63
  ViewVC Help
Powered by ViewVC 1.1.21