source: LMDZ5/trunk/libf/dyn3dmem/massbar_loc.F @ 1765

Last change on this file since 1765 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.1 KB
Line 
1      SUBROUTINE massbar_loc(  masse, massebx, masseby )
2     
3c
4c **********************************************************************
5c
6c  Calcule les moyennes en x et  y de la masse d'air dans chaque maille.
7c **********************************************************************
8c    Auteurs : P. Le Van , Fr. Hourdin  .
9c   ..........
10c
11c  ..  masse                 est  un argum. d'entree  pour le s-pg ...
12c  ..  massebx,masseby      sont des argum. de sortie pour le s-pg ...
13c     
14c
15      USE parallel
16      IMPLICIT NONE
17c
18#include "dimensions.h"
19#include "paramet.h"
20#include "comconst.h"
21#include "comgeom.h"
22c
23      REAL    masse( ijb_u:ije_u,llm ), massebx( ijb_u:ije_u,llm )  ,
24     *      masseby(   ijb_v:ije_v,llm )
25      INTEGER ij,l,ijb,ije
26c
27c
28c   Methode pour calculer massebx et masseby .
29c   ----------------------------------------
30c
31c    A chaque point scalaire P (i,j) est affecte 4 coefficients d'aires
32c       alpha1(i,j)  calcule  au point ( i+1/4,j-1/4 )
33c       alpha2(i,j)  calcule  au point ( i+1/4,j+1/4 )
34c       alpha3(i,j)  calcule  au point ( i-1/4,j+1/4 )
35c       alpha4(i,j)  calcule  au point ( i-1/4,j-1/4 )
36c
37c    Avec  alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j)       
38c
39c    N.B .  Pour plus de details, voir s-pg  ...  iniconst ...
40c
41c
42c
43c   alpha4 .         . alpha1    . alpha4
44c    (i,j)             (i,j)       (i+1,j)
45c
46c             P .        U .          . P
47c           (i,j)       (i,j)         (i+1,j)
48c
49c   alpha3 .         . alpha2    .alpha3
50c    (i,j)              (i,j)     (i+1,j)
51c
52c             V .        Z .          . V
53c           (i,j)
54c
55c   alpha4 .         . alpha1    .alpha4
56c   (i,j+1)            (i,j+1)   (i+1,j+1)
57c
58c             P .        U .          . P
59c          (i,j+1)                    (i+1,j+1)
60c
61c
62c
63c                       On  a :
64c
65c    massebx(i,j) = masse(i  ,j) * ( alpha1(i  ,j) + alpha2(i,j))   +
66c                   masse(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )
67c     localise  au point  ... U (i,j) ...
68c
69c    masseby(i,j) = masse(i,j  ) * ( alpha2(i,j  ) + alpha3(i,j  )  +
70c                   masse(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1) 
71c     localise  au point  ... V (i,j) ...
72c
73c
74c=======================================================================
75     
76     
77     
78c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
79      DO   100    l = 1 , llm
80c
81        ijb=ij_begin
82        ije=ij_end+iip1
83        if (pole_sud) ije=ije-iip1
84       
85        DO  ij = ijb, ije - 1
86         massebx(ij,l) =  masse( ij, l) * alpha1p2( ij  )     +
87     *                   masse(ij+1, l) * alpha3p4(ij+1 )
88        ENDDO
89
90c    .... correction pour massebx( iip1,j) .....
91c    ...    massebx(iip1,j)= massebx(1,j) ...
92c
93CDIR$ IVDEP
94
95       
96
97        DO  ij = ijb+iim, ije+iim, iip1
98         massebx( ij,l ) = massebx( ij - iim,l )
99        ENDDO
100
101
102     
103        ijb=ij_begin-iip1
104        ije=ij_end+iip1
105        if (pole_nord) ijb=ij_begin
106        if (pole_sud) ije=ij_end-iip1
107
108         DO  ij = ijb,ije
109         masseby( ij,l ) = masse(  ij   , l ) * alpha2p3(   ij    )  +
110     *                     masse(ij+iip1, l ) * alpha1p4( ij+iip1 )
111         ENDDO
112
113100   CONTINUE
114c$OMP END DO NOWAIT
115c
116      RETURN
117      END
Note: See TracBrowser for help on using the repository browser.