source: LMDZ5/trunk/libf/dyn3dmem/massdair_loc.F @ 1745

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