source: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/config/ppsrc/dyn/bernoui_p.f @ 224

Last change on this file since 224 was 224, checked in by ymipsl, 10 years ago
File size: 4.4 KB
Line 
1      SUBROUTINE bernoui_p (ngrid,nlay,pphi,pecin,pbern)
2      USE parallel_lmdz
3      IMPLICIT NONE
4
5c=======================================================================
6c
7c   Auteur:   P. Le Van
8c   -------
9c
10c   Objet:
11c   ------
12c     calcul de la fonction de Bernouilli aux niveaux s  .....
13c     phi  et  ecin  sont des arguments d'entree pour le s-pg .......
14c          bern       est un  argument de sortie pour le s-pg  ......
15c
16c    fonction de Bernouilli = bern = filtre de( geopotentiel +
17c                              energ.cinet.)
18c
19c=======================================================================
20c
21c-----------------------------------------------------------------------
22c   Decalrations:
23c   -------------
24c
25!-----------------------------------------------------------------------
26!   INCLUDE 'dimensions.h'
27!
28!   dimensions.h contient les dimensions du modele
29!   ndm est tel que iim=2**ndm
30!-----------------------------------------------------------------------
31
32      INTEGER iim,jjm,llm,ndm
33
34      PARAMETER (iim= 128,jjm=96,llm=64,ndm=1)
35
36!-----------------------------------------------------------------------
37!
38! $Header$
39!
40!
41!  ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
42!                 veillez  n'utiliser que des ! pour les commentaires
43!                 et  bien positionner les & des lignes de continuation
44!                 (les placer en colonne 6 et en colonne 73)
45!
46!
47!-----------------------------------------------------------------------
48!   INCLUDE 'paramet.h'
49
50      INTEGER  iip1,iip2,iip3,jjp1,llmp1,llmp2,llmm1
51      INTEGER  kftd,ip1jm,ip1jmp1,ip1jmi1,ijp1llm
52      INTEGER  ijmllm,mvar
53      INTEGER jcfil,jcfllm
54
55      PARAMETER( iip1= iim+1,iip2=iim+2,iip3=iim+3                       &
56     &    ,jjp1=jjm+1-1/jjm)
57      PARAMETER( llmp1 = llm+1,  llmp2 = llm+2, llmm1 = llm-1 )
58      PARAMETER( kftd  = iim/2 -ndm )
59      PARAMETER( ip1jm  = iip1*jjm,  ip1jmp1= iip1*jjp1 )
60      PARAMETER( ip1jmi1= ip1jm - iip1 )
61      PARAMETER( ijp1llm= ip1jmp1 * llm, ijmllm= ip1jm * llm )
62      PARAMETER( mvar= ip1jmp1*( 2*llm+1) + ijmllm )
63      PARAMETER( jcfil=jjm/2+5, jcfllm=jcfil*llm )
64
65!-----------------------------------------------------------------------
66!
67! $Id: logic.h 1520 2011-05-23 11:37:09Z emillour $
68!
69!
70! NB: keep items of different kinds in seperate common blocs to avoid
71!     "misaligned commons" issues
72!-----------------------------------------------------------------------
73! INCLUDE 'logic.h'
74
75      COMMON/logicl/ purmats,forward,leapf,apphys,                      &
76     &  statcl,conser,apdiss,apdelq,saison,ecripar,fxyhypb,ysinus       &
77     &  ,read_start,ok_guide,ok_strato,tidal,ok_gradsfile               &
78     &  ,ok_limit,ok_etat0,hybrid                                       &
79     &  ,moyzon_mu,moyzon_ch
80
81      COMMON/logici/ iflag_phys,iflag_trac
82     
83      LOGICAL purmats,forward,leapf,apphys,statcl,conser,               &
84     & apdiss,apdelq,saison,ecripar,fxyhypb,ysinus                      &
85     &  ,read_start,ok_guide,ok_strato,tidal,ok_gradsfile               &
86     &  ,ok_limit,ok_etat0
87      logical hybrid ! vertical coordinate is hybrid if true (sigma otherwise)
88                     ! (only used if disvert_type==2)
89      logical moyzon_mu,moyzon_ch ! used for zonal averages in Titan
90
91      integer iflag_phys,iflag_trac
92!$OMP THREADPRIVATE(/logicl/)
93!$OMP THREADPRIVATE(/logici/)
94!-----------------------------------------------------------------------
95c
96c   Arguments:
97c   ----------
98c
99      INTEGER nlay,ngrid
100      REAL pphi(ngrid,nlay),pecin(ngrid,nlay),pbern(ngrid,nlay)
101c
102c   Local:
103c   ------
104c
105      INTEGER   ij,l,ijb,ije,jjb,jje
106c
107c-----------------------------------------------------------------------
108c   calcul de Bernouilli:
109c   ---------------------
110c
111      ijb=ij_begin
112      ije=ij_end+iip1
113      if (pole_sud) ije=ij_end
114
115      jjb=jj_begin
116      jje=jj_end+1
117      if (pole_sud) jje=jj_end
118
119c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)               
120      DO l=1,llm
121   
122        DO 4 ij = ijb,ije
123          pbern( ij,l ) =  pphi( ij,l ) + pecin( ij,l )
124   4    CONTINUE
125       
126       ENDDO
127c$OMP END DO NOWAIT
128c
129c-----------------------------------------------------------------------
130c   filtre:
131c   -------
132c
133
134       
135        CALL filtreg_p( pbern,jjb,jje, jjp1, llm, 2,1, .true., 1 )
136c
137c-----------------------------------------------------------------------
138     
139     
140      RETURN
141      END
Note: See TracBrowser for help on using the repository browser.