source: LMDZ5/branches/LF-private/libf/dyn3dmem/pbar.F @ 5394

Last change on this file since 5394 was 1632, checked in by Laurent Fairhead, 12 years ago

Import initial du répertoire dyn3dmem

Attention! ceci n'est qu'une version préliminaire du code "basse mémoire":
le code contenu dans ce répertoire est basé sur la r1320 et a donc besoin
d'être mis à jour par rapport à la dynamique parallèle d'aujourd'hui.
Ce code est toutefois mis à disposition pour circonvenir à des problèmes
de mémoire que certaines configurations du modèle pourraient rencontrer.
Dans l'état, il compile et tourne sur vargas et au CCRT


Initial import of dyn3dmem

Warning! this is just a preliminary version of the memory light code:
it is based on r1320 of the code and thus needs to be updated before
it can replace the present dyn3dpar code. It is nevertheless put at your
disposal to circumvent some memory problems some LMDZ configurations may
encounter. In its present state, it will compile and run on vargas and CCRT

File size: 3.2 KB
Line 
1!
2! $Header$
3!
4      SUBROUTINE pbar ( pext, pbarx, pbary, pbarxy )
5      IMPLICIT NONE
6
7c=======================================================================
8c
9c   Auteur:  P. Le Van
10c   -------
11c
12c   Objet:
13c   ------
14c
15c **********************************************************************
16c calcul des moyennes en x et en y de (pression au sol*aire variable) ..
17c *********************************************************************
18c
19c          pext               est  un argum. d'entree  pour le s-pg ..
20c     pbarx,pbary et pbarxy  sont des argum. de sortie pour le s-pg ..
21c
22c   Methode:
23c   --------
24c
25c    A chaque point scalaire P (i,j) est affecte 4 coefficients d'aires
26c       alpha1(i,j)  calcule  au point ( i+1/4,j-1/4 )
27c       alpha2(i,j)  calcule  au point ( i+1/4,j+1/4 )
28c       alpha3(i,j)  calcule  au point ( i-1/4,j+1/4 )
29c       alpha4(i,j)  calcule  au point ( i-1/4,j-1/4 )
30c
31c    Avec  alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j)       
32c
33c    N.B .  Pour plus de details, voir s-pg  ...  iniconst ...
34c
35c
36c
37c   alpha4 .         . alpha1    . alpha4
38c    (i,j)             (i,j)       (i+1,j)
39c
40c             P .        U .          . P
41c           (i,j)       (i,j)         (i+1,j)
42c
43c   alpha3 .         . alpha2    .alpha3
44c    (i,j)              (i,j)     (i+1,j)
45c
46c             V .        Z .          . V
47c           (i,j)
48c
49c   alpha4 .         . alpha1    .alpha4
50c   (i,j+1)            (i,j+1)   (i+1,j+1)
51c
52c             P .        U .          . P
53c          (i,j+1)                    (i+1,j+1)
54c
55c
56c
57c
58c                       On  a :
59c
60c    pbarx(i,j) = Pext(i  ,j) * ( alpha1(i  ,j) + alpha2(i,j))      +
61c                 Pext(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )
62c     localise  au point  ... U (i,j) ...
63c
64c    pbary(i,j) = Pext(i,j  ) * ( alpha2(i,j  ) + alpha3(i,j  )     +
65c                 Pext(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1) 
66c     localise  au point  ... V (i,j) ...
67c
68c  pbarxy(i,j)= Pext(i,j) *alpha2(i,j) + Pext(i+1,j) *alpha3(i+1,j) +
69c               Pext(i,j+1)*alpha1(i,j+1)+ Pext(i+1,j+1)*alpha4(i+1,j+1)
70c     localise  au point  ... Z (i,j) ...
71c
72c
73c
74c=======================================================================
75
76
77#include "dimensions.h"
78#include "paramet.h"
79
80#include "comgeom.h"
81
82      REAL pext( ip1jmp1 ),  pbarx ( ip1jmp1 )
83      REAL pbary(  ip1jm  ),  pbarxy(  ip1jm  )
84
85      INTEGER   ij
86
87
88
89      DO 1 ij = 1, ip1jmp1 - 1
90      pbarx( ij ) = pext(ij) * alpha1p2(ij) + pext(ij+1)*alpha3p4(ij+1)
91   1  CONTINUE
92
93c    .... correction pour pbarx( iip1,j) .....
94
95c    ...    pbarx(iip1,j)= pbarx(1,j) ...
96CDIR$ IVDEP
97      DO 2 ij = iip1, ip1jmp1, iip1
98      pbarx( ij ) = pbarx( ij - iim )
99   2  CONTINUE
100
101
102      DO 3 ij = 1,ip1jm
103      pbary( ij ) = pext(   ij  )   * alpha2p3(   ij   )     +
104     *              pext( ij+iip1 ) * alpha1p4( ij+iip1 )
105   3  CONTINUE
106
107
108      DO 5 ij = 1, ip1jm - 1
109      pbarxy( ij ) = pext(ij)*alpha2(ij) + pext(ij+1)*alpha3(ij+1) +
110     *   pext(ij+iip1)*alpha1(ij+iip1) + pext(ij+iip2)*alpha4(ij+iip2)
111   5  CONTINUE
112
113
114c    ....  correction pour     pbarxy( iip1,j )  ........
115
116CDIR$ IVDEP
117
118      DO 7 ij = iip1, ip1jm, iip1
119      pbarxy( ij ) = pbarxy( ij - iim )
120   7  CONTINUE
121
122
123      RETURN
124      END
Note: See TracBrowser for help on using the repository browser.