/[lmdze]/trunk/phylmd/cltrac.f90
ViewVC logotype

Diff of /trunk/phylmd/cltrac.f90

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

revision 76 by guez, Fri Nov 15 18:45:49 2013 UTC revision 265 by guez, Tue Mar 20 09:35:59 2018 UTC
# Line 1  Line 1 
1  !  module cltrac_m
2  ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/cltrac.F,v 1.1.1.1 2004/05/19 12:53:07 lmdzadmin Exp $  
3  !    IMPLICIT NONE
4        SUBROUTINE cltrac(dtime,coef,t,tr,flux,paprs,pplay,delp,  
5       s                  d_tr)  contains
6        use dimens_m  
7         use dimphy    SUBROUTINE cltrac(dtime, coef, t, tr, flux, paprs, pplay, delp, d_tr)
8        use SUPHEC_M  
9        IMPLICIT none      ! From LMDZ4/libf/phylmd/cltrac.F,v 1.1.1.1 2004/05/19 12:53:07
10  c======================================================================  
11  c Auteur(s): O. Boucher (LOA/LMD) date: 19961127      USE dimensions
12  c            inspire de clvent      USE dimphy
13  c Objet: diffusion verticale de traceurs avec flux fixe a la surface      USE suphec_m
14  c        ou/et flux du type c-drag      ! ======================================================================
15  c======================================================================      ! Auteur(s): O. Boucher (LOA/LMD) date: 19961127
16  c Arguments:      ! inspire de clvent
17  c dtime----input-R- intervalle du temps (en second)      ! Objet: diffusion verticale de traceurs avec flux fixe a la surface
18  c coef-----input-R- le coefficient d'echange (m**2/s) l>1      ! ou/et flux du type c-drag
19  c tr-------input-R- la q. de traceurs      ! ======================================================================
20  c flux-----input-R- le flux de traceurs a la surface      ! Arguments:
21  c paprs----input-R- pression a inter-couche (Pa)      ! dtime----input-R- intervalle du temps (en second)
22  c pplay----input-R- pression au milieu de couche (Pa)      ! coef-----input-R- le coefficient d'echange (m**2/s) l>1
23  c delp-----input-R- epaisseur de couche (Pa)      ! tr-------input-R- la q. de traceurs
24  c cdrag----input-R- cdrag pour le flux de surface (non active)      ! flux-----input-R- le flux de traceurs a la surface
25  c tr0------input-R- traceurs a la surface ou dans l'ocean (non active)      ! paprs----input-R- pression a inter-couche (Pa)
26  c d_tr-----output-R- le changement de tr      ! pplay----input-R- pression au milieu de couche (Pa)
27  c flux_tr--output-R- flux de tr      ! delp-----input-R- epaisseur de couche (Pa)
28  c======================================================================      ! cdrag----input-R- cdrag pour le flux de surface (non active)
29        REAL, intent(in):: dtime      ! tr0------input-R- traceurs a la surface ou dans l'ocean (non active)
30        REAL coef(klon,klev)      ! d_tr-----output-R- le changement de tr
31        REAL, intent(in):: t(klon,klev) ! temperature (K)      ! flux_tr--output-R- flux de tr
32        real tr(klon,klev)      ! ======================================================================
33        REAL, intent(in):: paprs(klon,klev+1)      REAL, INTENT (IN) :: dtime
34        real, intent(in):: pplay(klon,klev)      REAL coef(:, 2:) ! (klon, 2:klev)
35        real delp(klon,klev)      REAL, INTENT (IN) :: t(klon, klev) ! temperature (K)
36        REAL d_tr(klon,klev)      REAL tr(klon, klev)
37        REAL flux(klon), cdrag(klon), tr0(klon)      REAL, INTENT (IN) :: paprs(klon, klev+1)
38  c      REAL flux_tr(klon,klev)      REAL, INTENT (IN) :: pplay(klon, klev)
39  c======================================================================      REAL delp(klon, klev)
40  c======================================================================      REAL d_tr(klon, klev)
41        INTEGER i, k      REAL flux(klon), cdrag(klon), tr0(klon)
42        REAL zx_ctr(klon,2:klev)      ! REAL flux_tr(klon,klev)
43        REAL zx_dtr(klon,2:klev)      ! ======================================================================
44        REAL zx_buf(klon)      ! ======================================================================
45        REAL zx_coef(klon,klev)      INTEGER i, k
46        REAL local_tr(klon,klev)      REAL zx_ctr(klon, 2:klev)
47        REAL zx_alf1(klon), zx_alf2(klon), zx_flux(klon)      REAL zx_dtr(klon, 2:klev)
48  c======================================================================      REAL zx_buf(klon)
49        DO k = 1, klev      REAL zx_coef(klon, klev)
50        DO i = 1, klon      REAL local_tr(klon, klev)
51           local_tr(i,k) = tr(i,k)      REAL zx_alf1(klon), zx_alf2(klon), zx_flux(klon)
52        ENDDO      ! ======================================================================
53        ENDDO      DO k = 1, klev
54  c         DO i = 1, klon
55              local_tr(i, k) = tr(i, k)
56  c======================================================================         END DO
57        DO i = 1, klon      END DO
58           zx_alf1(i) = (paprs(i,1)-pplay(i,2))/(pplay(i,1)-pplay(i,2))  
59           zx_alf2(i) = 1.0 - zx_alf1(i)  
60           zx_flux(i) =  -flux(i)*dtime*RG      ! ======================================================================
61  c--pour le moment le flux est prescrit      DO i = 1, klon
62  c--cdrag et zx_coef(1) vaut 0         zx_alf1(i) = (paprs(i,1)-pplay(i,2))/(pplay(i,1)-pplay(i,2))
63           cdrag(i) = 0.0         zx_alf2(i) = 1.0 - zx_alf1(i)
64           tr0(i) = 0.0         zx_flux(i) = -flux(i)*dtime*rg
65           zx_coef(i,1) = cdrag(i)*dtime*RG         ! --pour le moment le flux est prescrit
66        ENDDO         ! --cdrag et zx_coef(1) vaut 0
67  c======================================================================         cdrag(i) = 0.0
68        DO k = 2, klev         tr0(i) = 0.0
69        DO i = 1, klon         zx_coef(i, 1) = cdrag(i)*dtime*rg
70           zx_coef(i,k) = coef(i,k)*RG/(pplay(i,k-1)-pplay(i,k))      END DO
71       .                  *(paprs(i,k)*2/(t(i,k)+t(i,k-1))/RD)**2      ! ======================================================================
72           zx_coef(i,k) = zx_coef(i,k)*dtime*RG      DO k = 2, klev
73        ENDDO         DO i = 1, klon
74        ENDDO            zx_coef(i, k) = coef(i, k)*rg/(pplay(i,k-1)-pplay(i,k))* &
75  c======================================================================                 (paprs(i,k)*2/(t(i,k)+t(i,k-1))/rd)**2
76        DO i = 1, klon            zx_coef(i, k) = zx_coef(i, k)*dtime*rg
77           zx_buf(i) = delp(i,1) + zx_coef(i,1)*zx_alf1(i) + zx_coef(i,2)         END DO
78           zx_ctr(i,2) = (local_tr(i,1)*delp(i,1)+      END DO
79       .                  zx_coef(i,1)*tr0(i)-zx_flux(i))/zx_buf(i)      ! ======================================================================
80           zx_dtr(i,2) = (zx_coef(i,2)-zx_alf2(i)*zx_coef(i,1)) /      DO i = 1, klon
81       .                  zx_buf(i)         zx_buf(i) = delp(i, 1) + zx_coef(i, 1)*zx_alf1(i) + zx_coef(i, 2)
82        ENDDO         zx_ctr(i, 2) = (local_tr(i,1)*delp(i,1)+zx_coef(i,1)*tr0(i)-zx_flux(i))/ &
83  c              zx_buf(i)
84        DO k = 3, klev         zx_dtr(i, 2) = (zx_coef(i,2)-zx_alf2(i)*zx_coef(i,1))/zx_buf(i)
85        DO i = 1, klon      END DO
86           zx_buf(i) = delp(i,k-1) + zx_coef(i,k)  
87       .                  + zx_coef(i,k-1)*(1.-zx_dtr(i,k-1))      DO k = 3, klev
88           zx_ctr(i,k) = (local_tr(i,k-1)*delp(i,k-1)         DO i = 1, klon
89       .                  +zx_coef(i,k-1)*zx_ctr(i,k-1) )/zx_buf(i)            zx_buf(i) = delp(i, k-1) + zx_coef(i, k) + zx_coef(i, k-1)*(1.-zx_dtr(i &
90           zx_dtr(i,k) = zx_coef(i,k)/zx_buf(i)                 ,k-1))
91        ENDDO            zx_ctr(i, k) = (local_tr(i,k-1)*delp(i,k-1)+zx_coef(i,k-1)*zx_ctr(i,k-1 &
92        ENDDO                 ))/zx_buf(i)
93        DO i = 1, klon            zx_dtr(i, k) = zx_coef(i, k)/zx_buf(i)
94           local_tr(i,klev) = ( local_tr(i,klev)*delp(i,klev)         END DO
95       .                        +zx_coef(i,klev)*zx_ctr(i,klev) )      END DO
96       .                   / ( delp(i,klev) + zx_coef(i,klev)      DO i = 1, klon
97       .                       -zx_coef(i,klev)*zx_dtr(i,klev) )         local_tr(i, klev) = (local_tr(i,klev)*delp(i,klev)+zx_coef(i,klev)*zx_ctr &
98        ENDDO              (i,klev))/(delp(i,klev)+zx_coef(i,klev)-zx_coef(i,klev)*zx_dtr(i,klev))
99        DO k = klev-1, 1, -1      END DO
100        DO i = 1, klon      DO k = klev - 1, 1, -1
101           local_tr(i,k) = zx_ctr(i,k+1) + zx_dtr(i,k+1)*local_tr(i,k+1)         DO i = 1, klon
102        ENDDO            local_tr(i, k) = zx_ctr(i, k+1) + zx_dtr(i, k+1)*local_tr(i, k+1)
103        ENDDO         END DO
104  c======================================================================      END DO
105  c== flux_tr est le flux de traceur (positif vers bas)      ! ======================================================================
106  c      DO i = 1, klon      ! == flux_tr est le flux de traceur (positif vers bas)
107  c         flux_tr(i,1) = zx_coef(i,1)/(RG*dtime)      ! DO i = 1, klon
108  c      ENDDO      ! flux_tr(i,1) = zx_coef(i,1)/(RG*dtime)
109  c      DO k = 2, klev      ! ENDDO
110  c      DO i = 1, klon      ! DO k = 2, klev
111  c         flux_tr(i,k) = zx_coef(i,k)/(RG*dtime)      ! DO i = 1, klon
112  c     .               * (local_tr(i,k)-local_tr(i,k-1))      ! flux_tr(i,k) = zx_coef(i,k)/(RG*dtime)
113  c      ENDDO      ! .               * (local_tr(i,k)-local_tr(i,k-1))
114  c      ENDDO      ! ENDDO
115  c======================================================================      ! ENDDO
116        DO k = 1, klev      ! ======================================================================
117        DO i = 1, klon      DO k = 1, klev
118           d_tr(i,k) = local_tr(i,k) - tr(i,k)         DO i = 1, klon
119        ENDDO            d_tr(i, k) = local_tr(i, k) - tr(i, k)
120        ENDDO         END DO
121  c      END DO
122        RETURN  
123        END      RETURN
124      END SUBROUTINE cltrac
125    
126    end module cltrac_m
Legend:
Removed from v.76  
changed lines
  Added in v.265
  ViewVC Help
Powered by ViewVC 1.1.21