source: LMDZ5/trunk/libf/dyn3d/advect.F @ 2597

Last change on this file since 2597 was 2597, checked in by Ehouarn Millour, 8 years ago

Cleanup in the dynamics: get rid of comconst.h, make it a module comconst_mod.
EM
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 4.6 KB
Line 
1!
2! $Header$
3!
4      SUBROUTINE advect(ucov,vcov,teta,w,massebx,masseby,du,dv,dteta)
5
6      USE comconst_mod, ONLY: daysec
7     
8      IMPLICIT NONE
9c=======================================================================
10c
11c   Auteurs:  P. Le Van , Fr. Hourdin  .
12c   -------
13c
14c   Objet:
15c   ------
16c
17c   *************************************************************
18c   .... calcul des termes d'advection vertic.pour u,v,teta,q ...
19c   *************************************************************
20c        ces termes sont ajoutes a du,dv,dteta et dq .
21c  Modif F.Forget 03/94 : on retire q de advect
22c
23c=======================================================================
24c-----------------------------------------------------------------------
25c   Declarations:
26c   -------------
27
28      include "dimensions.h"
29      include "paramet.h"
30      include "comvert.h"
31      include "comgeom.h"
32      include "logic.h"
33      include "ener.h"
34
35c   Arguments:
36c   ----------
37
38      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
39      REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm),w(ip1jmp1,llm)
40      REAL dv(ip1jm,llm),du(ip1jmp1,llm),dteta(ip1jmp1,llm)
41
42c   Local:
43c   ------
44
45      REAL uav(ip1jmp1,llm),vav(ip1jm,llm),wsur2(ip1jmp1)
46      REAL unsaire2(ip1jmp1), ge(ip1jmp1)
47      REAL deuxjour, ww, gt, uu, vv
48
49      INTEGER  ij,l
50
51      REAL      SSUM
52
53c-----------------------------------------------------------------------
54c   2. Calculs preliminaires:
55c   -------------------------
56
57      IF (conser)  THEN
58         deuxjour = 2. * daysec
59
60         DO   1  ij   = 1, ip1jmp1
61         unsaire2(ij) = unsaire(ij) * unsaire(ij)
62   1     CONTINUE
63      END IF
64
65
66c------------------  -yy ----------------------------------------------
67c   .  Calcul de     u
68
69      DO  l=1,llm
70         DO    ij     = iip2, ip1jmp1
71            uav(ij,l) = 0.25 * ( ucov(ij,l) + ucov(ij-iip1,l) )
72         ENDDO
73         DO    ij     = iip2, ip1jm
74            uav(ij,l) = uav(ij,l) + uav(ij+iip1,l)
75         ENDDO
76         DO      ij         = 1, iip1
77            uav(ij      ,l) = 0.
78            uav(ip1jm+ij,l) = 0.
79         ENDDO
80      ENDDO
81
82c------------------  -xx ----------------------------------------------
83c   .  Calcul de     v
84
85      DO  l=1,llm
86         DO    ij   = 2, ip1jm
87          vav(ij,l) = 0.25 * ( vcov(ij,l) + vcov(ij-1,l) )
88         ENDDO
89         DO    ij   = 1,ip1jm,iip1
90          vav(ij,l) = vav(ij+iim,l)
91         ENDDO
92         DO    ij   = 1, ip1jm-1
93          vav(ij,l) = vav(ij,l) + vav(ij+1,l)
94         ENDDO
95         DO    ij       = 1, ip1jm, iip1
96          vav(ij+iim,l) = vav(ij,l)
97         ENDDO
98      ENDDO
99
100c-----------------------------------------------------------------------
101
102c
103      DO 20 l = 1, llmm1
104
105
106c       ......   calcul de  - w/2.    au niveau  l+1   .......
107
108      DO 5   ij   = 1, ip1jmp1
109      wsur2( ij ) = - 0.5 * w( ij,l+1 )
110   5  CONTINUE
111
112
113c     .....................     calcul pour  du     ..................
114
115      DO 6 ij = iip2 ,ip1jm-1
116      ww        = wsur2 (  ij  )     + wsur2( ij+1 )
117      uu        = 0.5 * ( ucov(ij,l) + ucov(ij,l+1) )
118      du(ij,l)  = du(ij,l)   - ww * ( uu - uav(ij, l ) )/massebx(ij, l )
119      du(ij,l+1)= du(ij,l+1) + ww * ( uu - uav(ij,l+1) )/massebx(ij,l+1)
120   6  CONTINUE
121
122c     .....  correction pour  du(iip1,j,l)  ........
123c     .....     du(iip1,j,l)= du(1,j,l)   .....
124
125CDIR$ IVDEP
126      DO   7  ij   = iip1 +iip1, ip1jm, iip1
127      du( ij, l  ) = du( ij -iim, l  )
128      du( ij,l+1 ) = du( ij -iim,l+1 )
129   7  CONTINUE
130
131c     .................    calcul pour   dv      .....................
132
133      DO 8 ij = 1, ip1jm
134      ww        = wsur2( ij+iip1 )   + wsur2( ij )
135      vv        = 0.5 * ( vcov(ij,l) + vcov(ij,l+1) )
136      dv(ij,l)  = dv(ij, l ) - ww * (vv - vav(ij, l ) )/masseby(ij, l )
137      dv(ij,l+1)= dv(ij,l+1) + ww * (vv - vav(ij,l+1) )/masseby(ij,l+1)
138   8  CONTINUE
139
140c
141
142c     ............................................................
143c     ...............    calcul pour   dh      ...................
144c     ............................................................
145
146c                       ---z
147c       calcul de  - d( teta  * w )      qu'on ajoute a   dh
148c                   ...............
149
150        DO 15 ij = 1, ip1jmp1
151         ww            = wsur2(ij) * (teta(ij,l) + teta(ij,l+1) )
152         dteta(ij, l ) = dteta(ij, l )  -  ww
153         dteta(ij,l+1) = dteta(ij,l+1)  +  ww
154  15    CONTINUE
155
156      IF( conser)  THEN
157        DO 17 ij = 1,ip1jmp1
158        ge(ij)   = wsur2(ij) * wsur2(ij) * unsaire2(ij)
159  17    CONTINUE
160        gt       = SSUM( ip1jmp1,ge,1 )
161        gtot(l)  = deuxjour * SQRT( gt/ip1jmp1 )
162      END IF
163
164  20  CONTINUE
165 
166      RETURN
167      END
Note: See TracBrowser for help on using the repository browser.