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

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

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

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