source: LMDZ6/trunk/libf/dyn3d_common/exner_milieu_m.F90 @ 3741

Last change on this file since 3741 was 2600, checked in by Ehouarn Millour, 8 years ago

Cleanup in the dynamics: turn comvert.h into module comvert_mod.F90
EM

  • 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
File size: 3.6 KB
Line 
1module exner_milieu_m
2
3  IMPLICIT NONE
4
5contains
6
7  SUBROUTINE  exner_milieu ( ngrid, ps, p, pks, pk, pkf )
8    !
9    !     Auteurs :  F. Forget , Y. Wanherdrick
10    ! P.Le Van  , Fr. Hourdin  .
11    !    ..........
12    !
13    !    ....  ngrid, ps,p             sont des argum.d'entree  au sous-prog ...
14    !    ....  pks,pk,pkf   sont des argum.de sortie au sous-prog ...
15    !
16    !   ************************************************************************
17    !    Calcule la fonction d'Exner pk = Cp * (p/preff) ** kappa , aux milieux des
18    !    couches .   Pk(l) sera calcule aux milieux  des couches l ,entre les
19    !    pressions p(l) et p(l+1) ,definis aux interfaces des llm couches .
20    !   ************************************************************************
21    !  .. N.B : Au sommet de l'atmosphere,  p(llm+1) = 0. , et ps et pks sont
22    !    la pression et la fonction d'Exner  au  sol  .
23    !
24    !     WARNING : CECI est une version speciale de exner_hyb originale
25    !               Utilise dans la version martienne pour pouvoir
26    !               tourner avec des coordonnees verticales complexe
27    !              => Il ne verifie PAS la condition la proportionalite en
28    !              energie totale/ interne / potentielle (F.Forget 2001)
29    !    ( voir note de Fr.Hourdin )  ,
30    !
31    !
32    USE comconst_mod, ONLY: jmp1, cpp, kappa, r
33    USE comvert_mod, ONLY: preff
34   
35    IMPLICIT NONE
36   
37    include "dimensions.h"
38    include "paramet.h"
39    include "comgeom.h"
40
41    INTEGER  ngrid
42    REAL p(ngrid,llmp1),pk(ngrid,llm)
43    real, optional:: pkf(ngrid,llm)
44    REAL ps(ngrid),pks(ngrid)
45
46    !    .... variables locales   ...
47
48    INTEGER l, ij
49    REAL dum1
50
51    logical,save :: firstcall=.true.
52    character(len=*),parameter :: modname="exner_milieu"
53
54    ! Sanity check
55    if (firstcall) then
56       ! sanity checks for Shallow Water case (1 vertical layer)
57       if (llm.eq.1) then
58          if (kappa.ne.1) then
59             call abort_gcm(modname, &
60                  "kappa!=1 , but running in Shallow Water mode!!",42)
61          endif
62          if (cpp.ne.r) then
63             call abort_gcm(modname, &
64                  "cpp!=r , but running in Shallow Water mode!!",42)
65          endif
66       endif ! of if (llm.eq.1)
67
68       firstcall=.false.
69    endif ! of if (firstcall)
70
71    ! Specific behaviour for Shallow Water (1 vertical layer) case:
72    if (llm.eq.1) then
73
74       ! Compute pks(:),pk(:),pkf(:)
75
76       DO   ij  = 1, ngrid
77          pks(ij) = (cpp/preff) * ps(ij)
78          pk(ij,1) = .5*pks(ij)
79       ENDDO
80
81       if (present(pkf)) then
82          pkf = pk
83          CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 )
84       end if
85
86       ! our work is done, exit routine
87       return
88    endif ! of if (llm.eq.1)
89
90    ! General case:
91
92    !     -------------
93    !     Calcul de pks
94    !     -------------
95
96    DO   ij  = 1, ngrid
97       pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
98    ENDDO
99
100    !    .... Calcul de pk  pour la couche l
101    !    --------------------------------------------
102    !
103    dum1 = cpp * (2*preff)**(-kappa)
104    DO l = 1, llm-1
105       DO   ij   = 1, ngrid
106          pk(ij,l) = dum1 * (p(ij,l) + p(ij,l+1))**kappa
107       ENDDO
108    ENDDO
109
110    !    .... Calcul de pk  pour la couche l = llm ..
111    !    (on met la meme distance (en log pression)  entre Pk(llm)
112    !    et Pk(llm -1) qu'entre Pk(llm-1) et Pk(llm-2)
113
114    DO   ij   = 1, ngrid
115       pk(ij,llm) = pk(ij,llm-1)**2 / pk(ij,llm-2)
116    ENDDO
117
118    if (present(pkf)) then
119       !    calcul de pkf
120       pkf = pk
121       CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 )
122    end if
123
124  END SUBROUTINE exner_milieu
125
126end module exner_milieu_m
Note: See TracBrowser for help on using the repository browser.