source: LMDZ.3.3/trunk/libf/dyn3d/exner_hyb.F @ 507

Last change on this file since 507 was 50, checked in by lmdz, 25 years ago

Calcul de valeurs uniques aux poles (suppression du test alphax)
LF

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 3.4 KB
Line 
1      SUBROUTINE  exner_hyb ( ngrid, ps, p,alpha,beta, 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    .... alpha,beta, 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 "comgeom.h"
34#include "comvert.h"
35#include "serre.h"
36
37      INTEGER  ngrid
38      REAL p(ngrid,llmp1),pk(ngrid,llm),pkf(ngrid,llm)
39      REAL ps(ngrid),pks(ngrid), alpha(ngrid,llm),beta(ngrid,llm)
40
41c    .... variables locales   ...
42
43      INTEGER l, ij
44      REAL unpl2k,dellta
45
46      REAL ppn(iim),pps(iim)
47      REAL xpn, xps
48      REAL SSUM
49      EXTERNAL filtreg, SSUM
50c
51     
52      unpl2k    = 1.+ 2.* kappa
53c
54      DO   ij  = 1, ngrid
55        pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
56      ENDDO
57
58      DO  ij   = 1, iim
59        ppn(ij) = aire(   ij   ) * pks(  ij     )
60        pps(ij) = aire(ij+ip1jm) * pks(ij+ip1jm )
61      ENDDO
62      xpn      = SSUM(iim,ppn,1) /apoln
63      xps      = SSUM(iim,pps,1) /apols
64
65      DO ij   = 1, iip1
66        pks(   ij     )  =  xpn
67        pks( ij+ip1jm )  =  xps
68      ENDDO
69c
70c
71c    .... Calcul des coeff. alpha et beta  pour la couche l = llm ..
72c
73      DO     ij      = 1, ngrid
74       alpha(ij,llm) = 0.
75       beta (ij,llm) = 1./ unpl2k
76      ENDDO
77c
78c     ... Calcul des coeff. alpha et beta  pour l = llm-1  a l = 2 ...
79c
80      DO l = llm -1 , 2 , -1
81c
82        DO ij = 1, ngrid
83        dellta = p(ij,l)* unpl2k + p(ij,l+1)* ( beta(ij,l+1)-unpl2k )
84        alpha(ij,l)  = - p(ij,l+1) / dellta * alpha(ij,l+1)
85        beta (ij,l)  =   p(ij,l  ) / dellta   
86        ENDDO
87c
88      ENDDO
89c
90c  ***********************************************************************
91c     .....  Calcul de pk pour la couche 1 , pres du sol  ....
92c
93      DO   ij   = 1, ngrid
94       pk(ij,1) = ( p(ij,1)*pks(ij) - 0.5*alpha(ij,2)*p(ij,2) )  /
95     *    (  p(ij,1)* (1.+kappa) + 0.5*( beta(ij,2)-unpl2k )* p(ij,2) )
96      ENDDO
97c
98c    ..... Calcul de pk(ij,l) , pour l = 2 a l = llm  ........
99c
100      DO l = 2, llm
101        DO   ij   = 1, ngrid
102         pk(ij,l) = alpha(ij,l) + beta(ij,l) * pk(ij,l-1)
103        ENDDO
104      ENDDO
105c
106c
107      CALL SCOPY   ( ngrid * llm, pk, 1, pkf, 1 )
108      CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 )
109     
110
111      RETURN
112      END
Note: See TracBrowser for help on using the repository browser.