source: LMDZ5/branches/AI-cosp/libf/dyn3d_common/exner_hyb_m.F90

Last change on this file was 2021, checked in by lguez, 11 years ago

Removed unused variables pks, pk, pkf from main program unit gcm.

Encapsulated procedures exner_hyb, exner_hyb_p, exner_hyb_loc,
exner_milieu, exner_milieu_p and exner_milieu_loc into
modules. (Compulsory to allow optional arguments.)

In the procedures exner_hyb, exner_hyb_p, exner_hyb_loc, donwgraded
arguments alpha and beta to local variables. In exner_milieu,
exner_milieu_p and exner_milieu_loc, removed beta altogether. In the
six procedures exner_*, made pkf an optional argument. Made some
cosmetic modifications in order to keep the six procedures exner_* as
close as possible.

In the six procedures exner_*, removed the averaging of pks at the
poles: this is not useful because ps is already the same at all
longitudes at the poles. This modification changes the results of the
program. Motivation: had to do this for exner_hyb because we call it
from test_disvert with a few surface pressure values.

In all the procedures calling exner_*, removed the variables alpha and
beta. Also removed variables alpha and beta from module leapfrog_mod
and from module call_calfis_mod.

Removed actual argument pkf in call to exner_hyb* and exner_milieu*
from guide_interp, guide_main, iniacademic and iniacademic_loc (pkf
was not used in those procedures).

Argument workvar of startget_dyn is used only if varname is tpot or

  1. When varname is tpot or q, the actual argument associated to

workvar in etat0_netcdf is not y. So y in etat0_netcdf is a
place-holder, never used. So we remove optional argument y in the
calls to exner_hyb and exner_milieu from etat0_netcdf.

Created procedure test_disvert, called only by etat0_netcdf. This
procedure tests the order of pressure values at half-levels and full
levels.

  • 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.3 KB
Line 
1module exner_hyb_m
2
3  IMPLICIT NONE
4
5contains
6
7  SUBROUTINE  exner_hyb ( ngrid, ps, p, pks, pk, pkf )
8
9    !     Auteurs :  P.Le Van  , Fr. Hourdin  .
10    !    ..........
11    !
12    !    ....  ngrid, ps,p             sont des argum.d'entree  au sous-prog ...
13    !    ....  pks,pk,pkf   sont des argum.de sortie au sous-prog ...
14    !
15    !   ************************************************************************
16    !    Calcule la fonction d'Exner pk = Cp * (p/preff) ** kappa , aux milieux des
17    !    couches .   Pk(l) sera calcule aux milieux  des couches l ,entre les
18    !    pressions p(l) et p(l+1) ,definis aux interfaces des llm couches .
19    !   ************************************************************************
20    !  .. N.B : Au sommet de l'atmosphere,  p(llm+1) = 0. , et ps et pks sont
21    !    la pression et la fonction d'Exner  au  sol  .
22    !
23    !                                 -------- z
24    !    A partir des relations  ( 1 ) p*dz(pk) = kappa *pk*dz(p)      et
25    !                            ( 2 ) pk(l) = alpha(l)+ beta(l)*pk(l-1)
26    !    ( voir note de Fr.Hourdin )  ,
27    !
28    !    on determine successivement , du haut vers le bas des couches, les
29    !    coef. alpha(llm),beta(llm) .,.,alpha(l),beta(l),,,alpha(2),beta(2),
30    !    puis pk(ij,1). Ensuite ,on calcule,du bas vers le haut des couches, 
31    !     pk(ij,l)  donne  par la relation (2),  pour l = 2 a l = llm .
32    !
33    !
34    !
35    include "dimensions.h"
36    include "paramet.h"
37    include "comconst.h"
38    include "comgeom.h"
39    include "comvert.h"
40    include "serre.h"
41
42    INTEGER  ngrid
43    REAL p(ngrid,llmp1),pk(ngrid,llm)
44    real, optional:: pkf(ngrid,llm)
45    REAL ps(ngrid),pks(ngrid), alpha(ngrid,llm),beta(ngrid,llm)
46
47    !    .... variables locales   ...
48
49    INTEGER l, ij
50    REAL unpl2k,dellta
51
52    logical,save :: firstcall=.true.
53    character(len=*),parameter :: modname="exner_hyb"
54
55    ! Sanity check
56    if (firstcall) then
57       ! sanity checks for Shallow Water case (1 vertical layer)
58       if (llm.eq.1) then
59          if (kappa.ne.1) then
60             call abort_gcm(modname, &
61                  "kappa!=1 , but running in Shallow Water mode!!",42)
62          endif
63          if (cpp.ne.r) then
64             call abort_gcm(modname, &
65                  "cpp!=r , but running in Shallow Water mode!!",42)
66          endif
67       endif ! of if (llm.eq.1)
68
69       firstcall=.false.
70    endif ! of if (firstcall)
71
72    ! Specific behaviour for Shallow Water (1 vertical layer) case:
73    if (llm.eq.1) then
74
75       ! Compute pks(:),pk(:),pkf(:)
76
77       DO   ij  = 1, ngrid
78          pks(ij) = (cpp/preff) * ps(ij)
79          pk(ij,1) = .5*pks(ij)
80       ENDDO
81
82       if (present(pkf)) then
83          pkf = pk
84          CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 )
85       end if
86
87       ! our work is done, exit routine
88       return
89    endif ! of if (llm.eq.1)
90
91    ! General case:
92
93    unpl2k    = 1.+ 2.* kappa
94
95    !     -------------
96    !     Calcul de pks
97    !     -------------
98
99    DO   ij  = 1, ngrid
100       pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
101    ENDDO
102
103    !    .... Calcul des coeff. alpha et beta  pour la couche l = llm ..
104    !
105    DO     ij      = 1, ngrid
106       alpha(ij,llm) = 0.
107       beta (ij,llm) = 1./ unpl2k
108    ENDDO
109    !
110    !     ... Calcul des coeff. alpha et beta  pour l = llm-1  a l = 2 ...
111    !
112    DO l = llm -1 , 2 , -1
113       !
114       DO ij = 1, ngrid
115          dellta = p(ij,l)* unpl2k + p(ij,l+1)* ( beta(ij,l+1)-unpl2k )
116          alpha(ij,l)  = - p(ij,l+1) / dellta * alpha(ij,l+1)
117          beta (ij,l)  =   p(ij,l  ) / dellta   
118       ENDDO
119    ENDDO
120
121    !  ***********************************************************************
122    !     .....  Calcul de pk pour la couche 1 , pres du sol  ....
123    !
124    DO   ij   = 1, ngrid
125       pk(ij,1) = ( p(ij,1)*pks(ij) - 0.5*alpha(ij,2)*p(ij,2) )  / &
126            (  p(ij,1)* (1.+kappa) + 0.5*( beta(ij,2)-unpl2k )* p(ij,2) )
127    ENDDO
128    !
129    !    ..... Calcul de pk(ij,l) , pour l = 2 a l = llm  ........
130    !
131    DO l = 2, llm
132       DO   ij   = 1, ngrid
133          pk(ij,l) = alpha(ij,l) + beta(ij,l) * pk(ij,l-1)
134       ENDDO
135    ENDDO
136
137    if (present(pkf)) then
138       !    calcul de pkf
139       pkf = pk
140       CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 )
141    end if
142
143  END SUBROUTINE exner_hyb
144
145end module exner_hyb_m
Note: See TracBrowser for help on using the repository browser.