source: LMDZ.3.3/branches/LF/libf/dyn3d/exner_hyb.F

Last change on this file 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: 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      IF( alphax.NE.0. )   THEN
59        DO  ij   = 1, iim
60         ppn(ij) = aire(   ij   ) * pks(  ij     )
61         pps(ij) = aire(ij+ip1jm) * pks(ij+ip1jm )
62        ENDDO
63         xpn      = SSUM(iim,ppn,1) /apoln
64         xps      = SSUM(iim,pps,1) /apols
65
66        DO ij   = 1, iip1
67         pks(   ij     )  =  xpn
68         pks( ij+ip1jm )  =  xps
69        ENDDO
70      ENDIF
71c
72c
73c    .... Calcul des coeff. alpha et beta  pour la couche l = llm ..
74c
75      DO     ij      = 1, ngrid
76       alpha(ij,llm) = 0.
77       beta (ij,llm) = 1./ unpl2k
78      ENDDO
79c
80c     ... Calcul des coeff. alpha et beta  pour l = llm-1  a l = 2 ...
81c
82      DO l = llm -1 , 2 , -1
83c
84        DO ij = 1, ngrid
85        dellta = p(ij,l)* unpl2k + p(ij,l+1)* ( beta(ij,l+1)-unpl2k )
86        alpha(ij,l)  = - p(ij,l+1) / dellta * alpha(ij,l+1)
87        beta (ij,l)  =   p(ij,l  ) / dellta   
88        ENDDO
89c
90      ENDDO
91c
92c  ***********************************************************************
93c     .....  Calcul de pk pour la couche 1 , pres du sol  ....
94c
95      DO   ij   = 1, ngrid
96       pk(ij,1) = ( p(ij,1)*pks(ij) - 0.5*alpha(ij,2)*p(ij,2) )  /
97     *    (  p(ij,1)* (1.+kappa) + 0.5*( beta(ij,2)-unpl2k )* p(ij,2) )
98      ENDDO
99c
100c    ..... Calcul de pk(ij,l) , pour l = 2 a l = llm  ........
101c
102      DO l = 2, llm
103        DO   ij   = 1, ngrid
104         pk(ij,l) = alpha(ij,l) + beta(ij,l) * pk(ij,l-1)
105        ENDDO
106      ENDDO
107c
108c
109      CALL SCOPY   ( ngrid * llm, pk, 1, pkf, 1 )
110      CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 )
111     
112
113      RETURN
114      END
Note: See TracBrowser for help on using the repository browser.