source: LMDZ4/trunk/libf/dyn3dpar/exner_hyb_p.F @ 5353

Last change on this file since 5353 was 1403, checked in by Laurent Fairhead, 14 years ago

Merged LMDZ4V5.0-dev branch changes r1292:r1399 to trunk.

Validation:
Validation consisted in compiling the HEAD revision of the trunk,
LMDZ4V5.0-dev branch and the merged sources and running different
configurations on local and SX8 machines comparing results.

Local machine: bench configuration, 32x24x11, gfortran

  • IPSLCM5A configuration (comparison between trunk and merged sources):
    • numerical convergence on dynamical fields over 3 days
    • start files are equivalent (except for RN and PB fields)
    • daily history files equivalent
  • MH07 configuration, new physics package (comparison between LMDZ4V5.0-dev branch and merged sources):
    • numerical convergence on dynamical fields over 3 days
    • start files are equivalent (except for RN and PB fields)
    • daily history files equivalent

SX8 machine (brodie), 96x95x39 on 4 processors:

  • IPSLCM5A configuration:
    • start files are equivalent (except for RN and PB fields)
    • monthly history files equivalent
  • MH07 configuration:
    • start files are equivalent (except for RN and PB fields)
    • monthly history files equivalent

Changes to the makegcm and create_make_gcm scripts to take into account
main programs in F90 files


Fusion de la branche LMDZ4V5.0-dev (r1292:r1399) au tronc principal

Validation:
La validation a consisté à compiler la HEAD de le trunk et de la banche
LMDZ4V5.0-dev et les sources fusionnées et de faire tourner le modéle selon
différentes configurations en local et sur SX8 et de comparer les résultats

En local: 32x24x11, config bench/gfortran

  • pour une config IPSLCM5A (comparaison tronc/fusion):
    • convergence numérique sur les champs dynamiques après 3 jours
    • restart et restartphy égaux (à part sur RN et Pb)
    • fichiers histoire égaux
  • pour une config nlle physique (MH07) (comparaison LMDZ4v5.0-dev/fusion):
    • convergence numérique sur les champs dynamiques après 3 jours
    • restart et restartphy égaux
    • fichiers histoire équivalents

Sur brodie, 96x95x39 sur 4 proc:

  • pour une config IPSLCM5A:
    • restart et restartphy égaux (à part sur RN et PB)
    • pas de différence dans les fichiers histmth.nc
  • pour une config MH07
    • restart et restartphy égaux (à part sur RN et PB)
    • pas de différence dans les fichiers histmth.nc

Changement sur makegcm et create_make-gcm pour pouvoir prendre en compte des
programmes principaux en *F90

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.6 KB
Line 
1!
2! $Id $
3!
4      SUBROUTINE  exner_hyb_p ( ngrid, ps, p,alpha,beta, pks, pk, pkf )
5c
6c     Auteurs :  P.Le Van  , Fr. Hourdin  .
7c    ..........
8c
9c    ....  ngrid, ps,p             sont des argum.d'entree  au sous-prog ...
10c    .... alpha,beta, pks,pk,pkf   sont des argum.de sortie au sous-prog ...
11c
12c   ************************************************************************
13c    Calcule la fonction d'Exner pk = Cp * p ** kappa , aux milieux des
14c    couches .   Pk(l) sera calcule aux milieux  des couches l ,entre les
15c    pressions p(l) et p(l+1) ,definis aux interfaces des llm couches .
16c   ************************************************************************
17c  .. N.B : Au sommet de l'atmosphere,  p(llm+1) = 0. , et ps et pks sont
18c    la pression et la fonction d'Exner  au  sol  .
19c
20c                                 -------- z                                   
21c    A partir des relations  ( 1 ) p*dz(pk) = kappa *pk*dz(p)      et
22c                            ( 2 ) pk(l) = alpha(l)+ beta(l)*pk(l-1)
23c    ( voir note de Fr.Hourdin )  ,
24c
25c    on determine successivement , du haut vers le bas des couches, les
26c    coef. alpha(llm),beta(llm) .,.,alpha(l),beta(l),,,alpha(2),beta(2),
27c    puis pk(ij,1). Ensuite ,on calcule,du bas vers le haut des couches, 
28c     pk(ij,l)  donne  par la relation (2),  pour l = 2 a l = llm .
29c
30c
31      USE parallel
32      IMPLICIT NONE
33c
34#include "dimensions.h"
35#include "paramet.h"
36#include "comconst.h"
37#include "comgeom.h"
38#include "comvert.h"
39#include "serre.h"
40
41      INTEGER  ngrid
42      REAL p(ngrid,llmp1),pk(ngrid,llm),pkf(ngrid,llm)
43      REAL ps(ngrid),pks(ngrid), alpha(ngrid,llm),beta(ngrid,llm)
44
45c    .... variables locales   ...
46
47      INTEGER l, ij
48      REAL unpl2k,dellta
49
50      REAL ppn(iim),pps(iim)
51      REAL xpn, xps
52      REAL SSUM
53      EXTERNAL SSUM
54      INTEGER ije,ijb,jje,jjb
55c
56c$OMP BARRIER
57
58      if (llm.eq.1) then
59        ! Specific behaviour for Shallow Water (1 vertical layer) case
60     
61        ! Sanity checks
62        if (kappa.ne.1) then
63          call abort_gcm("exner_hyb",
64     &    "kappa!=1 , but running in Shallow Water mode!!",42)
65        endif
66        if (cpp.ne.r) then
67        call abort_gcm("exner_hyb",
68     &    "cpp!=r , but running in Shallow Water mode!!",42)
69        endif
70       
71        ! Compute pks(:),pk(:),pkf(:)
72        ijb=ij_begin
73        ije=ij_end
74!$OMP DO SCHEDULE(STATIC)
75        DO ij=ijb, ije
76          pks(ij)=(cpp/preff)*ps(ij)
77          pk(ij,1) = .5*pks(ij)
78          pkf(ij,1)=pk(ij,1)
79        ENDDO
80!$OMP ENDDO
81
82!$OMP MASTER
83      if (pole_nord) then
84        DO  ij   = 1, iim
85          ppn(ij) = aire(   ij   ) * pks(  ij     )
86        ENDDO
87        xpn      = SSUM(iim,ppn,1) /apoln
88 
89        DO ij   = 1, iip1
90          pks(   ij     )  =  xpn
91          pk(ij,1) = .5*pks(ij)
92          pkf(ij,1)=pk(ij,1)
93        ENDDO
94      endif
95     
96      if (pole_sud) then
97        DO  ij   = 1, iim
98          pps(ij) = aire(ij+ip1jm) * pks(ij+ip1jm )
99        ENDDO
100        xps      = SSUM(iim,pps,1) /apols
101 
102        DO ij   = 1, iip1
103          pks( ij+ip1jm )  =  xps
104          pk(ij+ip1jm,1)=.5*pks(ij+ip1jm)
105          pkf(ij+ip1jm,1)=pk(ij+ip1jm,1)
106        ENDDO
107      endif
108!$OMP END MASTER
109
110        jjb=jj_begin
111        jje=jj_end
112        CALL filtreg_p ( pkf,jjb,jje, jmp1, llm, 2, 1, .TRUE., 1 )
113
114        ! our work is done, exit routine
115        return
116      endif ! of if (llm.eq.1)
117
118
119      unpl2k    = 1.+ 2.* kappa
120c
121      ijb=ij_begin
122      ije=ij_end
123
124c$OMP DO SCHEDULE(STATIC)
125      DO   ij  = ijb, ije
126        pks(ij) = cpp * ( ps(ij)/preff ) ** kappa
127      ENDDO
128c$OMP ENDDO
129c Synchro OPENMP ici
130
131c$OMP MASTER
132      if (pole_nord) then
133        DO  ij   = 1, iim
134          ppn(ij) = aire(   ij   ) * pks(  ij     )
135        ENDDO
136        xpn      = SSUM(iim,ppn,1) /apoln
137 
138        DO ij   = 1, iip1
139          pks(   ij     )  =  xpn
140        ENDDO
141      endif
142     
143      if (pole_sud) then
144        DO  ij   = 1, iim
145          pps(ij) = aire(ij+ip1jm) * pks(ij+ip1jm )
146        ENDDO
147        xps      = SSUM(iim,pps,1) /apols
148 
149        DO ij   = 1, iip1
150          pks( ij+ip1jm )  =  xps
151        ENDDO
152      endif
153c$OMP END MASTER
154c
155c
156c    .... Calcul des coeff. alpha et beta  pour la couche l = llm ..
157c
158c$OMP DO SCHEDULE(STATIC)
159      DO     ij      = ijb,ije
160       alpha(ij,llm) = 0.
161       beta (ij,llm) = 1./ unpl2k
162      ENDDO
163c$OMP ENDDO NOWAIT
164c
165c     ... Calcul des coeff. alpha et beta  pour l = llm-1  a l = 2 ...
166c
167      DO l = llm -1 , 2 , -1
168c
169c$OMP DO SCHEDULE(STATIC)
170        DO ij = ijb, ije
171        dellta = p(ij,l)* unpl2k + p(ij,l+1)* ( beta(ij,l+1)-unpl2k )
172        alpha(ij,l)  = - p(ij,l+1) / dellta * alpha(ij,l+1)
173        beta (ij,l)  =   p(ij,l  ) / dellta   
174        ENDDO
175c$OMP ENDDO NOWAIT
176c
177      ENDDO
178
179c
180c  ***********************************************************************
181c     .....  Calcul de pk pour la couche 1 , pres du sol  ....
182c
183c$OMP DO SCHEDULE(STATIC)
184      DO   ij   = ijb, ije
185       pk(ij,1) = ( p(ij,1)*pks(ij) - 0.5*alpha(ij,2)*p(ij,2) )  /
186     *    (  p(ij,1)* (1.+kappa) + 0.5*( beta(ij,2)-unpl2k )* p(ij,2) )
187      ENDDO
188c$OMP ENDDO NOWAIT
189c
190c    ..... Calcul de pk(ij,l) , pour l = 2 a l = llm  ........
191c
192      DO l = 2, llm
193c$OMP DO SCHEDULE(STATIC)
194        DO   ij   = ijb, ije
195         pk(ij,l) = alpha(ij,l) + beta(ij,l) * pk(ij,l-1)
196        ENDDO
197c$OMP ENDDO NOWAIT       
198      ENDDO
199c
200c
201c      CALL SCOPY   ( ngrid * llm, pk, 1, pkf, 1 )
202      DO l = 1, llm
203c$OMP DO SCHEDULE(STATIC)
204         DO   ij   = ijb, ije
205           pkf(ij,l)=pk(ij,l)
206         ENDDO
207c$OMP ENDDO NOWAIT             
208      ENDDO
209
210c$OMP BARRIER
211     
212      jjb=jj_begin
213      jje=jj_end
214      CALL filtreg_p ( pkf,jjb,jje, jmp1, llm, 2, 1, .TRUE., 1 )
215     
216
217      RETURN
218      END
Note: See TracBrowser for help on using the repository browser.