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