source: trunk/LMDZ.COMMON/libf/dyn3dpar/flumass_p.F @ 2902

Last change on this file since 2902 was 1019, checked in by emillour, 11 years ago

Common dynamics; keep up with updates (seq and ) in LMDZ5 (up tio rev 1845):

  • General stuff:
  • makelmdz_fcm: add options -j # (compile using # threads) and -full, and to keep up

with Earth model, possibility to compile with various versions of orchidee

  • bld.cfg: adaptations to enable compiling using multiple threads
  • build_gcm: adaptations to enable compiling using multiple threads
  • makelmdz: keep up with Earth model: possibility to compile with various versions of orchidee + cosmetic changes + library directory name change
  • bibio:
  • wxios.F90 : Added for possible future use of XIOS library
  • filtrez:
  • mkl_dft_type.f90 & mkl_dfti.f90 : MKL (for MKL FFT) interface definitions
  • filtreg_mod : limit use of FFT to parallel mode
  • mod_filtre_fft.F90 & mod_filtre_fft_lov.F90 : swich to use parallel_lmdz
  • dyn3d:
  • abort_gcm.F : add things for xios
  • advtrac.F90 : minor change in CFL outputs
  • ce0l.F90 : indicesol.h is now module indice_sol_mod
  • comvert.h : cosmetic change on comments
  • gcm.F : add xios and use module indice_sol_mod (for INCA)
  • inigeom.F : move two computations outside loop
  • dyn3dpar:
  • parallel.F90 => parallel_lmdz.F90 : and change all the "use parallel" into "use parallel_lmdz" in all files in dyn3dpar
  • comvert.h : cosmetic change on comments
  • gcm.F : add xios and use module indice_sol_mod (for INCA)
  • leapfrog_p.F : add xios + correction for times in Newtonian case
  • ce0l.F90 : indicesol.h is now module indice_sol_mod
  • inigeom.F : move two computations outside loop

EM
File size: 4.3 KB
RevLine 
[1]1      SUBROUTINE flumass_p(massebx,masseby, vcont, ucont, pbaru, pbarv)
[1019]2      USE parallel_lmdz
[1]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( ip1jmp1,llm ),masseby( ip1jm,llm ) ,
27     * vcont( ip1jm,llm ),ucont( ip1jmp1,llm ),pbaru( ip1jmp1,llm ),
28     * pbarv( ip1jm,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.