source: trunk/libf/dyn3dpar/exner_milieu_p.F @ 121

Last change on this file since 121 was 109, checked in by slebonnois, 14 years ago

SLebonnois: discretisation verticale: cohabitation entre
la methode Terre et les autres.

File size: 3.7 KB
Line 
1      SUBROUTINE  exner_milieu ( ngrid, ps, p,beta, pks, pk, pkf )
2c
3c     Auteurs :  F. Forget , Y. Wanherdrick
4c P.Le Van  , Fr. Hourdin  .
5c    ..........
6c
7c    ....  ngrid, ps,p             sont des argum.d'entree  au sous-prog ...
8c    .... beta, pks,pk,pkf   sont des argum.de sortie au sous-prog ...
9c
10c   ************************************************************************
11c    Calcule la fonction d'Exner pk = Cp * (p/preff) ** kappa , aux milieux des
12c    couches .   Pk(l) sera calcule aux milieux  des couches l ,entre les
13c    pressions p(l) et p(l+1) ,definis aux interfaces des llm couches .
14c   ************************************************************************
15c    .. N.B : Au sommet de l'atmosphere,  p(llm+1) = 0. , et ps et pks sont
16c    la pression et la fonction d'Exner  au  sol  .
17c
18c     WARNING : CECI est une version speciale de exner_hyb originale
19c               Utilise dans la version martienne pour pouvoir
20c               tourner avec des coordonnees verticales complexe
21c              => Il ne verifie PAS la condition la proportionalite en
22c              energie totale/ interne / potentielle (F.Forget 2001)
23c    ( voir note de Fr.Hourdin )  ,
24c
25      USE parallel
26      IMPLICIT NONE
27c
28#include "dimensions.h"
29#include "paramet.h"
30#include "comconst.h"
31#include "comgeom.h"
32#include "comvert.h"
33#include "serre.h"
34
35      INTEGER  ngrid
36      REAL p(ngrid,llmp1),pk(ngrid,llm),pkf(ngrid,llm)
37      REAL ps(ngrid),pks(ngrid), beta(ngrid,llm)
38
39c    .... variables locales   ...
40
41      INTEGER l, ij
42      REAL dum1
43
44      REAL ppn(iim),pps(iim)
45      REAL xpn, xps
46      REAL SSUM
47      EXTERNAL SSUM
48      INTEGER ije,ijb,jje,jjb
49     
50c$OMP BARRIER
51
52c     -------------
53c     Calcul de pks
54c     -------------
55   
56      ijb=ij_begin
57      ije=ij_end
58
59c$OMP DO SCHEDULE(STATIC)
60      DO   ij  = ijb, ije
61        pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
62      ENDDO
63c$OMP ENDDO
64c Synchro OPENMP ici
65
66c$OMP MASTER
67      if (pole_nord) then
68        DO  ij   = 1, iim
69          ppn(ij) = aire(   ij   ) * pks(  ij     )
70        ENDDO
71        xpn      = SSUM(iim,ppn,1) /apoln
72 
73        DO ij   = 1, iip1
74          pks(   ij     )  =  xpn
75        ENDDO
76      endif
77     
78      if (pole_sud) then
79        DO  ij   = 1, iim
80          pps(ij) = aire(ij+ip1jm) * pks(ij+ip1jm )
81        ENDDO
82        xps      = SSUM(iim,pps,1) /apols
83 
84        DO ij   = 1, iip1
85          pks( ij+ip1jm )  =  xps
86        ENDDO
87      endif
88c$OMP END MASTER
89c
90c
91c    .... Calcul de pk  pour la couche l
92c    --------------------------------------------
93c
94      dum1 = cpp * (2*preff)**(-kappa)
95      DO l = 1, llm-1
96c$OMP DO SCHEDULE(STATIC)
97        DO   ij   = ijb, ije
98         pk(ij,l) = dum1 * (p(ij,l) + p(ij,l+1))**kappa
99        ENDDO
100c$OMP ENDDO NOWAIT       
101      ENDDO
102
103c    .... Calcul de pk  pour la couche l = llm ..
104c    (on met la meme distance (en log pression)  entre Pk(llm)
105c    et Pk(llm -1) qu'entre Pk(llm-1) et Pk(llm-2)
106
107c$OMP DO SCHEDULE(STATIC)
108      DO   ij   = ijb, ije
109         pk(ij,llm) = pk(ij,llm-1)**2 / pk(ij,llm-2)
110      ENDDO
111c$OMP ENDDO NOWAIT       
112
113
114c    calcul de pkf
115c    -------------
116c      CALL SCOPY   ( ngrid * llm, pk, 1, pkf, 1 )
117      DO l = 1, llm
118c$OMP DO SCHEDULE(STATIC)
119         DO   ij   = ijb, ije
120           pkf(ij,l)=pk(ij,l)
121         ENDDO
122c$OMP ENDDO NOWAIT             
123      ENDDO
124
125c$OMP BARRIER
126     
127      jjb=jj_begin
128      jje=jj_end
129      CALL filtreg_p ( pkf,jjb,jje, jmp1, llm, 2, 1, .TRUE., 1 )
130     
131c    EST-CE UTILE ?? : calcul de beta
132c    --------------------------------
133      DO l = 2, llm
134c$OMP DO SCHEDULE(STATIC)
135        DO   ij   = ijb, ije
136          beta(ij,l) = pk(ij,l) / pk(ij,l-1)   
137        ENDDO
138c$OMP ENDDO NOWAIT             
139      ENDDO
140
141      RETURN
142      END
Note: See TracBrowser for help on using the repository browser.