source: LMDZ.3.3/trunk/libf/dyn3d/exnerF @ 346

Last change on this file since 346 was 2, checked in by lmdz, 25 years ago

Initial revision

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 2.8 KB
Line 
1      SUBROUTINE  exner ( ngrid, ps, p, pks, pk, pkf )
2c
3c     Auteurs :  P.Le Van  , Fr. Hourdin  .
4c    ..........
5c
6c    .... ngrid, ps,p  sont des argum.d'entree  au sous-prog.   ....
7c    .... pks,pk,pkf   sont des argum.de sortie au sous-prog.   ....
8c
9c   ************************************************************************
10c    Calcule la fonction d'Exner pk = Cp * p ** kappa , aux milieux des
11c    couches .   Pk(l) sera calcule aux milieux  des couches l ,entre les
12c    pressions p(l) et p(l+1) ,definis aux interfaces des llm couches .
13c   ************************************************************************
14c  .. N.B : Au sommet de l'atmosphere,  p(llm+1) = 0. , et ps et pks sont
15c    la pression et la fonction d'Exner  au  sol  .
16c
17c                                 -------- z                                   
18c    A partir des relations  ( 1 ) p*dz(pk) = kappa *pk*dz(p)      et
19c                            ( 2 ) pk(l) = alpha(l)+ beta(l)*pk(l-1)
20c    ( voir note de Fr.Hourdin )  ,
21c
22c    on determine successivement , du haut vers le bas des couches, les
23c    coef. alpha(llm),beta(llm) .,.,alpha(l),beta(l),,,alpha(2),beta(2),
24c    puis pk(ij,1). Ensuite ,on calcule,du bas vers le haut des couches, 
25c     pk(ij,l)  donne  par la relation (2),  pour l = 2 a l = llm .
26c
27c
28      IMPLICIT NONE
29c
30#include "dimensions.h"
31#include "paramet.h"
32#include "comconst.h"
33#include "comvert.h"
34
35      INTEGER  ngrid
36      REAL p(ngrid,llmp1),pk(ngrid,llm),pkf(ngrid,llm)
37      REAL ps(ngrid),pks(ngrid)
38      INTEGER l, ij
39      REAL alpha(ngrid,llm),beta(ngrid,llm),unpl2k,delta
40      EXTERNAL filtreg
41c
42      unpl2k    = 1.+ 2.* kappa
43c
44      DO   ij  = 1, ngrid
45       pks(ij) = cpp * (ps(ij)/preff) ** kappa
46      ENDDO
47c
48c    .... Calcul des coeff. alpha et beta  pour la couche l = llm ..
49c
50      DO     ij      = 1, ngrid
51       alpha(ij,llm) = 0.
52       beta (ij,llm) = 1./ unpl2k
53      ENDDO
54c
55c     ... Calcul des coeff. alpha et beta  pour l = llm-1  a l = 2 ...
56c
57      DO l = llm -1 , 2 , -1
58c
59        DO ij = 1, ngrid
60        delta = p(ij,l)* unpl2k + p(ij,l+1)* ( beta(ij,l+1)-unpl2k )
61        alpha(ij,l)  = - p(ij,l+1) / delta * alpha(ij,l+1)
62        beta (ij,l)  =   p(ij,l  ) / delta   
63        ENDDO
64c
65      ENDDO
66c
67c  ***********************************************************************
68c     .....  Calcul de pk pour la couche 1 , pres du sol  ....
69c
70      DO   ij   = 1, ngrid
71       pk(ij,1) = ( p(ij,1)*pks(ij) - 0.5*alpha(ij,2)*p(ij,2) )  /
72     *    (  p(ij,1)* (1.+kappa) + 0.5*( beta(ij,2)-unpl2k )* p(ij,2) )
73      ENDDO
74c
75c    ..... Calcul de pk(ij,l) , pour l = 2 a l = llm  ........
76c
77      DO l = 2, llm
78        DO   ij   = 1, ngrid
79         pk(ij,l) = alpha(ij,l) + beta(ij,l) * pk(ij,l-1)
80        ENDDO
81      ENDDO
82c
83c
84      CALL SCOPY   ( ngrid * llm, pk, 1, pkf, 1 )
85      CALL filtreg ( pkf, jmp1, llm, 2, 1, .true., 1)
86
87      RETURN
88      END
Note: See TracBrowser for help on using the repository browser.