source: LMDZ5/trunk/libf/dyn3dmem/flumass_loc.F @ 1758

Last change on this file since 1758 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: 4.3 KB
RevLine 
[1632]1      SUBROUTINE flumass_loc(massebx,masseby,vcont,ucont,pbaru,pbarv)
2      USE parallel
3      IMPLICIT NONE
4
5c=======================================================================
6c
7c   Auteurs:  P. Le Van, F. Hourdin  .
8c   -------
9c
10c   Objet:
11c   ------
12c
13c *********************************************************************
14c     .... calcul du flux de masse  aux niveaux s ......
15c *********************************************************************
16c   massebx,masseby,vcont et ucont sont des argum. d'entree pour le s-pg .
17c       pbaru  et pbarv            sont des argum.de sortie pour le s-pg .
18c
19c=======================================================================
20
21
22#include "dimensions.h"
23#include "paramet.h"
24#include "comgeom.h"
25
26      REAL massebx( ijb_u:ije_u,llm ),masseby( ijb_v:ije_v,llm ) ,
27     * vcont( ijb_v:ije_v,llm ),ucont( ijb_u:ije_u,llm ),
28     * pbaru( ijb_u:ije_u,llm ),pbarv( ijb_v:ije_v,llm )
29
30      REAL apbarun( iip1 ),apbarus( iip1 )
31
32      REAL sairen,saireun,saires,saireus,ctn,cts,ctn0,cts0
33      INTEGER  l,ij,i
34      INTEGER ijb,ije
35     
36      EXTERNAL   SSUM
37      REAL       SSUM
38     
39c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
40      DO  5 l = 1,llm
41
42        ijb=ij_begin
43        ije=ij_end+iip1
44     
45        if (pole_nord) ijb=ij_begin+iip1
46        if (pole_sud)  ije=ij_end-iip1
47       
48        DO  1 ij = ijb,ije
49          pbaru( ij,l ) = massebx( ij,l ) * ucont( ij,l )
50   1    CONTINUE
51
52        ijb=ij_begin-iip1
53        ije=ij_end+iip1
54     
55        if (pole_nord) ijb=ij_begin
56        if (pole_sud)  ije=ij_end-iip1
57       
58        DO 3 ij = ijb,ije
59          pbarv( ij,l ) = masseby( ij,l ) * vcont( ij,l )
60   3    CONTINUE
61
62   5  CONTINUE
63c$OMP END DO NOWAIT
64c    ................................................................
65c     calcul de la composante du flux de masse en x aux poles .......
66c    ................................................................
67c     par la resolution d'1 systeme de 2 equations .
68
69c     la premiere equat.decrivant le calcul de la divergence en 1 point i
70c     du pole,ce calcul etant itere de i=1 a i=im .
71c                 c.a.d   ,
72c     ( ( 0.5*pbaru(i)-0.5*pbaru(i-1) - pbarv(i))/aire(i)   =
73c                                           - somme de ( pbarv(n) )/aire pole
74
75c     l'autre equat.specifiant que la moyenne du flux de masse au pole est =0.
76c     c.a.d    somme de pbaru(n)*aire locale(n) = 0.
77
78c     on en revient ainsi a determiner la constante additive commune aux pbaru
79c     qui representait pbaru(0,j,l) dans l'equat.du calcul de la diverg.au pt
80c     i=1 .
81c     i variant de 1 a im
82c     n variant de 1 a im
83
84      IF (pole_nord) THEN
85     
86        sairen = SSUM( iim,  aire(   1     ), 1 )
87        saireun= SSUM( iim, aireu(   1     ), 1 )
88
89c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
90        DO l = 1,llm
91 
92          ctn =  SSUM( iim, pbarv(    1     ,l),  1 )/ sairen
93     
94          pbaru(1,l)=pbarv(1,l) - ctn * aire(1)
95       
96          DO i = 2,iim
97            pbaru(i,l) = pbaru(i- 1,l )    +
98     *                   pbarv(i,l) - ctn * aire(i )
99          ENDDO
100       
101          DO i = 1,iim
102            apbarun(i) = aireu(    i   ) * pbaru(   i    , l)
103          ENDDO
104     
105          ctn0 = -SSUM( iim,apbarun,1 )/saireun
106       
107          DO i = 1,iim
108            pbaru(   i    , l) = 2. * ( pbaru(   i    , l) + ctn0 )
109          ENDDO
110       
111          pbaru(   iip1 ,l ) = pbaru(    1    ,l )
112       
113        ENDDO
114c$OMP END DO NOWAIT             
115
116      ENDIF
117
118     
119      IF (pole_sud) THEN
120 
121        saires = SSUM( iim,  aire( ip1jm+1 ), 1 )
122        saireus= SSUM( iim, aireu( ip1jm+1 ), 1 )
123
124c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
125        DO  l = 1,llm
126 
127          cts =  SSUM( iim, pbarv(ip1jmi1+ 1,l),  1 )/ saires
128          pbaru(ip1jm+1,l)= - pbarv(ip1jmi1+1,l) + cts * aire(ip1jm+1)
129   
130          DO i = 2,iim
131            pbaru(i+ ip1jm,l) = pbaru(i+ip1jm-1,l)    -
132     *                          pbarv(i+ip1jmi1,l)+cts*aire(i+ip1jm)
133          ENDDO
134       
135          DO i = 1,iim
136            apbarus(i) = aireu(i +ip1jm) * pbaru(i +ip1jm, l)
137          ENDDO
138
139          cts0 = -SSUM( iim,apbarus,1 )/saireus
140
141          DO i = 1,iim
142            pbaru(i+ ip1jm, l) = 2. * ( pbaru(i +ip1jm, l) + cts0 )
143          ENDDO
144
145          pbaru( ip1jmp1,l ) = pbaru( ip1jm +1,l )
146       
147        ENDDO
148c$OMP END DO NOWAIT         
149      ENDIF
150     
151      RETURN
152      END
Note: See TracBrowser for help on using the repository browser.