source: LMDZ5/trunk/libf/dyn3dpar/exner_milieu_p_m.F90

Last change on this file 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: 4.3 KB
RevLine 
[2021]1module exner_milieu_p_m
[1520]2
[2021]3  IMPLICIT NONE
[1520]4
[2021]5contains
[1520]6
[2021]7  SUBROUTINE  exner_milieu_p ( 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    USE parallel_lmdz
[2597]32    USE comconst_mod, ONLY: cpp, kappa, r, jmp1
[2600]33    USE comvert_mod, ONLY: preff
[2021]34    !
35    include "dimensions.h"
36    include "paramet.h"
37    include "comgeom.h"
[1520]38
[2021]39    INTEGER  ngrid
40    REAL p(ngrid,llmp1),pk(ngrid,llm)
41    REAL, optional:: pkf(ngrid,llm)
42    REAL ps(ngrid),pks(ngrid)
[1520]43
[2021]44    !    .... variables locales   ...
45
[2026]46    INTEGER l, ij,ijb,ije,jjb,jje
[2021]47    REAL dum1
48
49    logical,save :: firstcall=.true.
50    !$OMP THREADPRIVATE(firstcall)
51    character(len=*),parameter :: modname="exner_milieu_p"
52
53    ! Sanity check
54    if (firstcall) then
55       ! sanity checks for Shallow Water case (1 vertical layer)
56       if (llm.eq.1) then
[1520]57          if (kappa.ne.1) then
[2021]58             call abort_gcm(modname, &
59                  "kappa!=1 , but running in Shallow Water mode!!",42)
[1520]60          endif
61          if (cpp.ne.r) then
[2021]62             call abort_gcm(modname, &
63                  "cpp!=r , but running in Shallow Water mode!!",42)
[1520]64          endif
[2021]65       endif ! of if (llm.eq.1)
[1520]66
[2021]67       firstcall=.false.
68    endif ! of if (firstcall)
[1520]69
[2021]70    !$OMP BARRIER
[1520]71
[2021]72    ! Specific behaviour for Shallow Water (1 vertical layer) case:
73    if (llm.eq.1) then
74
75       ! Compute pks(:),pk(:),pkf(:)
76       ijb=ij_begin
77       ije=ij_end
78       !$OMP DO SCHEDULE(STATIC)
79       DO ij=ijb, ije
80          pks(ij) = (cpp/preff) * ps(ij)
[1520]81          pk(ij,1) = .5*pks(ij)
[2021]82          if (present(pkf)) pkf(ij,1)=pk(ij,1)
83       ENDDO
84       !$OMP ENDDO
[1520]85
[2021]86       !$OMP BARRIER
87       if (present(pkf)) then
88          jjb=jj_begin
89          jje=jj_end
90          CALL filtreg_p ( pkf,jjb,jje, jmp1, llm, 2, 1, .TRUE., 1 )
91       end if
[1520]92
[2021]93       ! our work is done, exit routine
94       return
95    endif ! of if (llm.eq.1)
[1520]96
[2021]97    ! General case:
[1520]98
[2021]99    !     -------------
100    !     Calcul de pks
101    !     -------------
[1520]102
[2021]103    ijb=ij_begin
104    ije=ij_end
[1520]105
[2021]106    !$OMP DO SCHEDULE(STATIC)
107    DO   ij  = ijb, ije
108       pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
109    ENDDO
110    !$OMP ENDDO
111    ! Synchro OPENMP ici
[1520]112
[2021]113    !$OMP BARRIER
114    !
115    !
116    !    .... Calcul de pk  pour la couche l
117    !    --------------------------------------------
118    !
119    dum1 = cpp * (2*preff)**(-kappa)
120    DO l = 1, llm-1
121       !$OMP DO SCHEDULE(STATIC)
122       DO   ij   = ijb, ije
123          pk(ij,l) = dum1 * (p(ij,l) + p(ij,l+1))**kappa
124       ENDDO
125       !$OMP ENDDO NOWAIT
126    ENDDO
[1520]127
[2021]128    !    .... Calcul de pk  pour la couche l = llm ..
129    !    (on met la meme distance (en log pression)  entre Pk(llm)
130    !    et Pk(llm -1) qu'entre Pk(llm-1) et Pk(llm-2)
[1520]131
[2021]132    !$OMP DO SCHEDULE(STATIC)
133    DO   ij   = ijb, ije
134       pk(ij,llm) = pk(ij,llm-1)**2 / pk(ij,llm-2)
135    ENDDO
136    !$OMP ENDDO NOWAIT       
[1520]137
[2021]138    if (present(pkf)) then
139       !    calcul de pkf
[1520]140
[2021]141       DO l = 1, llm
142          !$OMP DO SCHEDULE(STATIC)
143          DO   ij   = ijb, ije
144             pkf(ij,l)=pk(ij,l)
145          ENDDO
146          !$OMP ENDDO NOWAIT
147       ENDDO
148
149       !$OMP BARRIER
150
151       jjb=jj_begin
152       jje=jj_end
153       CALL filtreg_p ( pkf,jjb,jje, jmp1, llm, 2, 1, .TRUE., 1 )
154    end if
155
156  END SUBROUTINE exner_milieu_p
157
158end module exner_milieu_p_m
Note: See TracBrowser for help on using the repository browser.