← Back to branch summary

~ubuntu-branches/ubuntu/precise/code-saturne/precise

« back to all changes in this revision

Viewing changes to src/cfbl/cfmsfl.f90

  • Committer: Package Import Robot
  • Author(s): Sylvestre Ledru
  • Date: 2011-11-01 17:43:32 UTC
  • mto: (6.1.7 sid)
  • mto: This revision was merged to the branch mainline in revision 11.
  • Revision ID: package-import@ubuntu.com-20111101174332-tl4vk45no0x3emc3
Tags: upstream-2.1.0
Import upstream version 2.1.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/cfbl/cfmsfl.f90
1
1
!-------------------------------------------------------------------------------
2
2
 
3
 
!     This file is part of the Code_Saturne Kernel, element of the
4
 
!     Code_Saturne CFD tool.
5
 
 
6
 
!     Copyright (C) 1998-2009 EDF S.A., France
7
 
 
8
 
!     contact: saturne-support@edf.fr
9
 
 
10
 
!     The Code_Saturne Kernel is free software; you can redistribute it
11
 
!     and/or modify it under the terms of the GNU General Public License
12
 
!     as published by the Free Software Foundation; either version 2 of
13
 
!     the License, or (at your option) any later version.
14
 
 
15
 
!     The Code_Saturne Kernel is distributed in the hope that it will be
16
 
!     useful, but WITHOUT ANY WARRANTY; without even the implied warranty
17
 
!     of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18
 
!     GNU General Public License for more details.
19
 
 
20
 
!     You should have received a copy of the GNU General Public License
21
 
!     along with the Code_Saturne Kernel; if not, write to the
22
 
!     Free Software Foundation, Inc.,
23
 
!     51 Franklin St, Fifth Floor,
24
 
!     Boston, MA  02110-1301  USA
 
3
! This file is part of Code_Saturne, a general-purpose CFD tool.
 
4
!
 
5
! Copyright (C) 1998-2011 EDF S.A.
 
6
!
 
7
! This program is free software; you can redistribute it and/or modify it under
 
8
! the terms of the GNU General Public License as published by the Free Software
 
9
! Foundation; either version 2 of the License, or (at your option) any later
 
10
! version.
 
11
!
 
12
! This program is distributed in the hope that it will be useful, but WITHOUT
 
13
! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
 
14
! FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
 
15
! details.
 
16
!
 
17
! You should have received a copy of the GNU General Public License along with
 
18
! this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
 
19
! Street, Fifth Floor, Boston, MA 02110-1301, USA.
25
20
 
26
21
!-------------------------------------------------------------------------------
27
22
 
28
23
subroutine cfmsfl &
29
24
!================
30
25
 
31
 
 ( idbia0 , idbra0 ,                                              &
32
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
33
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
34
 
   nvar   , nscal  , nphas  , ncepdp , ncesmp ,                   &
35
 
   nideve , nrdeve , nituse , nrtuse , iscal  ,                   &
36
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
37
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
 
26
 ( nvar   , nscal  , ncepdp , ncesmp ,                            &
 
27
   iscal  ,                                                       &
38
28
   icepdc , icetsm , itypsm ,                                     &
39
 
   idevel , ituser , ia     ,                                     &
40
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
41
29
   dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
42
30
   coefa  , coefb  , ckupdc , smacel ,                            &
43
31
   flumas , flumab ,                                              &
44
 
   w1     , w2     , w3     , w4     , w5     , w6     ,          &
45
 
   w7     , w8     , w9     , w10    , w11    , w12    ,          &
46
 
   trflms , trflmb , coefu  , xam    ,                            &
47
 
   rdevel , rtuser ,                                              &
48
 
   ra     )
 
32
   trflms , trflmb , coefu  )
49
33
 
50
34
!===============================================================================
51
35
! FONCTION :
59
43
!__________________.____._____.________________________________________________.
60
44
! name             !type!mode ! role                                           !
61
45
!__________________!____!_____!________________________________________________!
62
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
63
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
64
 
! ndim             ! i  ! <-- ! spatial dimension                              !
65
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
66
 
! ncel             ! i  ! <-- ! number of cells                                !
67
 
! nfac             ! i  ! <-- ! number of interior faces                       !
68
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
69
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
70
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
71
 
! nnod             ! i  ! <-- ! number of vertices                             !
72
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
73
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
74
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
75
46
! nvar             ! i  ! <-- ! total number of variables                      !
76
47
! nscal            ! i  ! <-- ! total number of scalars                        !
77
 
! nphas            ! i  ! <-- ! number of phases                               !
78
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
79
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
80
48
! iscal            ! i  ! <-- ! scalar number                                  !
81
49
! itspdv           ! e  ! <-- ! calcul termes sources prod et dissip           !
82
50
!                  !    !     !  (0 : non , 1 : oui)                           !
83
 
! ifacel(2, nfac)  ! ia ! <-- ! interior faces -> cells connectivity           !
84
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
85
 
! ifmfbr(nfabor)   ! ia ! <-- ! boundary face family numbers                   !
86
 
! ifmcel(ncelet)   ! ia ! <-- ! cell family numbers                            !
87
 
! iprfml           ! ia ! <-- ! property numbers per family                    !
88
 
!  (nfml, nprfml)  !    !     !                                                !
89
 
! ipnfac(nfac+1)   ! ia ! <-- ! interior faces -> vertices index (optional)    !
90
 
! nodfac(lndfac)   ! ia ! <-- ! interior faces -> vertices list (optional)     !
91
 
! ipnfbr(nfabor+1) ! ia ! <-- ! boundary faces -> vertices index (optional)    !
92
 
! nodfbr(lndfbr)   ! ia ! <-- ! boundary faces -> vertices list (optional)     !
93
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
94
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
95
 
! ia(*)            ! ia ! --- ! main integer work array                        !
96
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
97
 
!  (ndim, ncelet)  !    !     !                                                !
98
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
99
 
!  (ndim, nfac)    !    !     !                                                !
100
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
101
 
!  (ndim, nfabor)  !    !     !                                                !
102
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
103
 
!  (ndim, nfac)    !    !     !                                                !
104
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
105
 
!  (ndim, nfabor)  !    !     !                                                !
106
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !
107
 
!  (ndim, nnod)    !    !     !                                                !
108
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !
109
51
! dt(ncelet)       ! ra ! <-- ! time step (per cell)                           !
110
52
! rtp, rtpa        ! ra ! <-- ! calculated variables at cell centers           !
111
53
!  (ncelet, *)     !    !     !  (at current and previous time steps)          !
118
60
!  (nfabor, *)     !    !     !                                                !
119
61
! flumas(nfac)     ! tr ! --> ! flux de masse aux faces internes               !
120
62
! flumab(nfabor    ! tr ! --> ! flux de masse aux faces de bord                !
121
 
! w1..12(ncelet    ! tr ! --- ! tableau de travail                             !
122
63
! trflms(nfac)     ! tr ! --- ! tableau de travail                             !
123
64
! trflmb(nfabor    ! tr ! --- ! tableau de travail                             !
124
65
! coefu(nfabo,3    ! tr ! --- ! tableau de travail cl de la qdm                !
125
 
! xam(nfac,*)      ! tr ! --- ! tableau de travail pour matrice                !
126
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
127
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
128
 
! ra(*)            ! ra ! --- ! main real work array                           !
129
66
!__________________!____!_____!________________________________________________!
130
67
 
131
68
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
132
69
!            L (LOGIQUE)   .. ET TYPES COMPOSES (EX : TR TABLEAU REEL)
133
70
!     MODE : <-- donnee, --> resultat, <-> Donnee modifiee
134
71
!            --- tableau de travail
135
 
!-------------------------------------------------------------------------------
 
72
!===============================================================================
 
73
 
 
74
!===============================================================================
 
75
! Module files
 
76
!===============================================================================
 
77
 
 
78
use paramx
 
79
use numvar
 
80
use entsor
 
81
use optcal
 
82
use cstphy
 
83
use cstnum
 
84
use parall
 
85
use period
 
86
use ppppar
 
87
use ppthch
 
88
use ppincl
 
89
use mesh
 
90
 
136
91
!===============================================================================
137
92
 
138
93
implicit none
139
94
 
140
 
!===============================================================================
141
 
! Common blocks
142
 
!===============================================================================
143
 
 
144
 
include "paramx.h"
145
 
include "numvar.h"
146
 
include "entsor.h"
147
 
include "optcal.h"
148
 
include "cstphy.h"
149
 
include "cstnum.h"
150
 
include "pointe.h"
151
 
include "period.h"
152
 
include "parall.h"
153
 
include "ppppar.h"
154
 
include "ppthch.h"
155
 
include "ppincl.h"
156
 
 
157
 
!===============================================================================
158
 
 
159
95
! Arguments
160
96
 
161
 
integer          idbia0 , idbra0
162
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
163
 
integer          nfml   , nprfml
164
 
integer          nnod   , lndfac , lndfbr , ncelbr
165
 
integer          nvar   , nscal  , nphas
 
97
integer          nvar   , nscal
166
98
integer          ncepdp , ncesmp
167
 
integer          nideve , nrdeve , nituse , nrtuse
168
99
integer          iscal
169
100
 
170
 
integer          ifacel(2,nfac) , ifabor(nfabor)
171
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
172
 
integer          iprfml(nfml,nprfml)
173
 
integer          ipnfac(nfac+1), nodfac(lndfac)
174
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr)
175
101
integer          icepdc(ncepdp)
176
102
integer          icetsm(ncesmp), itypsm(ncesmp,nvar)
177
 
integer          idevel(nideve), ituser(nituse)
178
 
integer          ia(*)
179
103
 
180
 
double precision xyzcen(ndim,ncelet)
181
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
182
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
183
 
double precision xyznod(ndim,nnod), volume(ncelet)
184
104
double precision dt(ncelet), rtp(ncelet,*), rtpa(ncelet,*)
185
105
double precision propce(ncelet,*)
186
106
double precision propfa(nfac,*), propfb(nfabor,*)
187
107
double precision coefa(nfabor,*), coefb(nfabor,*)
188
108
double precision ckupdc(ncepdp,6), smacel(ncesmp,nvar)
189
109
double precision flumas(nfac), flumab(nfabor)
190
 
double precision w1(ncelet) , w2(ncelet) , w3(ncelet)
191
 
double precision w4(ncelet) , w5(ncelet) , w6(ncelet)
192
 
double precision w7(ncelet) , w8(ncelet) , w9(ncelet)
193
 
double precision w10(ncelet), w11(ncelet), w12(ncelet)
194
110
double precision trflms(nfac), trflmb(nfabor)
195
 
double precision coefu(nfabor,3), xam(nfac,2)
196
 
double precision rdevel(nrdeve), rtuser(nrtuse)
197
 
double precision ra(*)
 
111
double precision coefu(nfabor,3)
198
112
 
199
113
! Local variables
200
114
 
201
 
integer          idebia, idebra, ifinia
202
 
integer          ivar  , iphas
 
115
integer          ivar
203
116
integer          ifac  , iel
204
117
integer          init  , inc   , iccocg, ii, jj
205
118
integer          ipp
209
122
 
210
123
integer          iirom , iiromb
211
124
integer          ivar0 , imvis1, iccfth, imodif, isou
212
 
integer          imaspe, iflmb0, iismph
 
125
integer          imaspe, iflmb0
213
126
integer          icliup, iclivp, icliwp, iclvar
214
 
integer          idimte, itenso
215
 
integer          iuiph , iviph , iwiph
216
127
integer          itsqdm, iiun  , iextts
217
 
integer          maxelt, ils
218
128
 
219
129
double precision epsrgp, climgp, extrap, blencp
220
130
double precision flui  , fluj  , pfac  , thetv
221
131
 
 
132
double precision, allocatable, dimension(:) :: w1, w2, w3
 
133
double precision, allocatable, dimension(:) :: w4, w5, w6
 
134
double precision, allocatable, dimension(:) :: w7, w8, w9
 
135
double precision, allocatable, dimension(:) :: w10, w11, w12
 
136
 
222
137
!===============================================================================
223
138
 
224
139
!===============================================================================
225
140
! 1. INITIALISATION
226
141
!===============================================================================
227
142
 
228
 
idebia = idbia0
229
 
idebra = idbra0
 
143
! Allocate work arrays
 
144
allocate(w1(ncelet), w2(ncelet), w3(ncelet))
 
145
allocate(w4(ncelet), w5(ncelet), w6(ncelet))
 
146
allocate(w7(ncelet), w8(ncelet), w9(ncelet))
 
147
allocate(w10(ncelet), w11(ncelet), w12(ncelet))
230
148
 
231
 
! --- Numero de phase associee au scalaire traite
232
 
iphas  = iphsca(iscal)
233
149
 
234
150
! --- Numero des variables de calcul
235
151
!     Masse volumique
236
152
ivar   = isca(iscal)
237
 
!     Vitesses
238
 
iuiph  = iu(iphas)
239
 
iviph  = iv(iphas)
240
 
iwiph  = iw(iphas)
241
153
 
242
154
!     Masse volumique dans PROPCE
243
 
iirom  = ipproc(irom  (iphas))
244
 
iiromb = ipprob(irom  (iphas))
 
155
iirom  = ipproc(irom  )
 
156
iiromb = ipprob(irom  )
245
157
 
246
158
! ---> Initialisation du flux de masse
247
159
 
305
217
 
306
218
! --- Terme source utilisateur
307
219
 
308
 
  maxelt = max(ncelet, nfac, nfabor)
309
 
  ils    = idebia
310
 
  ifinia = ils + maxelt
311
 
  CALL IASIZE('CFMSFL',IFINIA)
312
 
 
313
220
!     Suivant X
314
221
  call ustsns                                                     &
315
222
  !==========
316
 
 ( ifinia , idebra ,                                              &
317
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
318
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
319
 
   nvar   , nscal  , nphas  , ncepdp , ncesmp ,                   &
320
 
   nideve , nrdeve , nituse , nrtuse ,                            &
321
 
   iuiph  , iphas  ,                                              &
322
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml , maxelt , ia(ils), &
323
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
 
223
 ( nvar   , nscal  , ncepdp , ncesmp ,                            &
 
224
   iu  ,                                                          &
324
225
   icepdc , icetsm , itypsm ,                                     &
325
 
   idevel , ituser , ia     ,                                     &
326
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
327
226
   dt     , rtpa   , propce , propfa , propfb ,                   &
328
227
   coefa  , coefb  , ckupdc , smacel ,                            &
329
 
   w10    , w9     ,                                              &
330
 
!        ------   ------
331
 
   w8     , xam    ,                                              &
332
 
   w1     , w2     , w3     , w4     , w5     , w6     ,          &
333
 
   rdevel , rtuser , ra     )
 
228
   w10    , w9     )
334
229
 
335
230
!     Suivant Y
336
231
  call ustsns                                                     &
337
232
  !==========
338
 
 ( ifinia , idebra ,                                              &
339
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
340
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
341
 
   nvar   , nscal  , nphas  , ncepdp , ncesmp ,                   &
342
 
   nideve , nrdeve , nituse , nrtuse ,                            &
343
 
   iviph  , iphas  ,                                              &
344
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml , maxelt , ia(ils), &
345
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
 
233
 ( nvar   , nscal  , ncepdp , ncesmp ,                            &
 
234
   iv  ,                                                          &
346
235
   icepdc , icetsm , itypsm ,                                     &
347
 
   idevel , ituser , ia     ,                                     &
348
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
349
236
   dt     , rtpa   , propce , propfa , propfb ,                   &
350
237
   coefa  , coefb  , ckupdc , smacel ,                            &
351
 
   w11    , w9     ,                                              &
352
 
!        ------   ------
353
 
   w8     , xam    ,                                              &
354
 
   w1     , w2     , w3     , w4     , w5     , w6     ,          &
355
 
   rdevel , rtuser , ra     )
 
238
   w11    , w9     )
356
239
 
357
240
!     Suivant Z
358
241
  call ustsns                                                     &
359
242
  !==========
360
 
 ( ifinia , idebra ,                                              &
361
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
362
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
363
 
   nvar   , nscal  , nphas  , ncepdp , ncesmp ,                   &
364
 
   nideve , nrdeve , nituse , nrtuse ,                            &
365
 
   iwiph  , iphas  ,                                              &
366
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml , maxelt , ia(ils), &
367
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
 
243
 ( nvar   , nscal  , ncepdp , ncesmp ,                            &
 
244
   iw  ,                                                          &
368
245
   icepdc , icetsm , itypsm ,                                     &
369
 
   idevel , ituser , ia     ,                                     &
370
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
371
246
   dt     , rtpa   , propce , propfa , propfb ,                   &
372
247
   coefa  , coefb  , ckupdc , smacel ,                            &
373
 
   w12    , w9     ,                                              &
374
 
!        ------   ------
375
 
   w8     , xam    ,                                              &
376
 
   w1     , w2     , w3     , w4     , w5     , w6     ,          &
377
 
   rdevel , rtuser , ra     )
 
248
   w12    , w9     )
378
249
 
379
250
 
380
251
! --- Terme de convection de quantite de mouvement
381
 
  if(iconv(iuiph).ge.1) then
 
252
  if(iconv(iu).ge.1) then
382
253
 
383
 
    icliup = iclrtp(iuiph ,icoef)
384
 
    iclivp = iclrtp(iviph ,icoef)
385
 
    icliwp = iclrtp(iwiph ,icoef)
 
254
    icliup = iclrtp(iu ,icoef)
 
255
    iclivp = iclrtp(iv ,icoef)
 
256
    icliwp = iclrtp(iw ,icoef)
386
257
 
387
258
    init   = 1
388
259
    inc    = 1
389
260
    iccocg = 1
390
261
    iflmb0 = 1
391
 
    iismph = iisymp+nfabor*(iphas-1)
392
 
    nswrgp = nswrgr(iuiph)
393
 
    imligp = imligr(iuiph)
394
 
    iwarnp = iwarni(iuiph)
395
 
    epsrgp = epsrgr(iuiph)
396
 
    climgp = climgr(iuiph)
397
 
    extrap = extrag(iuiph)
 
262
    nswrgp = nswrgr(iu)
 
263
    imligp = imligr(iu)
 
264
    iwarnp = iwarni(iu)
 
265
    epsrgp = epsrgr(iu)
 
266
    climgp = climgr(iu)
 
267
    extrap = extrag(iu)
398
268
 
399
269
    imaspe = 1
400
270
 
401
271
!     Calcul du flux de masse
402
272
    call inimas                                                   &
403
273
    !==========
404
 
 ( idebia , idebra ,                                              &
405
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
406
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
407
 
   nvar   , nscal  , nphas  ,                                     &
408
 
   iuiph  , iviph  , iwiph  , imaspe , iphas  ,                   &
409
 
   nideve , nrdeve , nituse , nrtuse ,                            &
 
274
 ( nvar   , nscal  ,                                              &
 
275
   iu  , iv  , iw  , imaspe ,                                     &
410
276
   iflmb0 , init   , inc    , imrgra , iccocg , nswrgp , imligp , &
411
277
   iwarnp , nfecra ,                                              &
412
278
   epsrgp , climgp , extrap ,                                     &
413
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
414
 
   ipnfac , nodfac , ipnfbr , nodfbr , ia(iismph) ,               &
415
 
   idevel , ituser , ia     ,                                     &
416
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
417
279
   propce(1,iirom) , propfb(1,iiromb),                            &
418
 
   rtpa (1,iuiph)  , rtpa (1,iviph)  , rtpa (1,iwiph)  ,          &
 
280
   rtpa (1,iu)  , rtpa (1,iv)  , rtpa (1,iw)  ,                   &
419
281
   coefa(1,icliup) , coefa(1,iclivp) , coefa(1,icliwp) ,          &
420
282
   coefb(1,icliup) , coefb(1,iclivp) , coefb(1,icliwp) ,          &
421
 
   flumas , flumab ,                                              &
422
 
!        ------   ------
423
 
   w1     , w2     , w3     , w4     , w5     , w6     ,          &
424
 
   w7     , w8     , w9     , coefu  ,                            &
425
 
   rdevel , rtuser , ra     )
 
283
   flumas , flumab )
426
284
 
427
285
!     Calcul du terme convecte suivant les 3 directions
428
286
!       sans reconstruction
429
287
    do isou = 1, 3
430
 
      if(isou.eq.1) ivar0  = iuiph
 
288
      if(isou.eq.1) ivar0  = iu
431
289
      if(isou.eq.1) iclvar = icliup
432
 
      if(isou.eq.2) ivar0  = iviph
 
290
      if(isou.eq.2) ivar0  = iv
433
291
      if(isou.eq.2) iclvar = iclivp
434
 
      if(isou.eq.3) ivar0  = iwiph
 
292
      if(isou.eq.3) ivar0  = iw
435
293
      if(isou.eq.3) iclvar = icliwp
436
294
 
437
295
      do ifac = 1, nfac
470
328
 
471
329
! --- Terme de viscosite
472
330
 
473
 
  if( idiff(iuiph).ge.1 ) then
 
331
  if( idiff(iu).ge.1 ) then
474
332
 
475
333
    do iel = 1, ncelet
476
334
      w8(iel) = 1.d0
479
337
 
480
338
    call cfdivs                                                   &
481
339
    !==========
482
 
 ( idebia , idebra ,                                              &
483
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
484
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
485
 
   nvar   , nscal  , nphas  , ncepdp , ncesmp ,                   &
486
 
   nideve , nrdeve , nituse , nrtuse , iphas  ,                   &
487
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
488
 
   ipnfac , nodfac , ipnfbr , nodfbr , icepdc , icetsm , itypsm , &
489
 
   idevel , ituser , ia     ,                                     &
490
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
491
 
   rtpa   , propce , propfa , propfb ,                            &
492
 
   coefa  , coefb  , ckupdc , smacel ,                            &
493
 
   w10    , w8     , w9     , w9     ,                            &
494
 
!        ------
495
 
   w7     ,                                                       &
496
 
   w1     , w2     , w3     , w4     , w5     , w6     ,          &
497
 
   rdevel , rtuser , ra     )
498
 
 
499
 
    call cfdivs                                                   &
500
 
    !==========
501
 
 ( idebia , idebra ,                                              &
502
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
503
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
504
 
   nvar   , nscal  , nphas  , ncepdp , ncesmp ,                   &
505
 
   nideve , nrdeve , nituse , nrtuse , iphas  ,                   &
506
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
507
 
   ipnfac , nodfac , ipnfbr , nodfbr , icepdc , icetsm , itypsm , &
508
 
   idevel , ituser , ia     ,                                     &
509
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
510
 
   rtpa   , propce , propfa , propfb ,                            &
511
 
   coefa  , coefb  , ckupdc , smacel ,                            &
512
 
   w11    , w9     , w8     , w9     ,                            &
513
 
!        ------
514
 
   w7     ,                                                       &
515
 
   w1     , w2     , w3     , w4     , w5     , w6     ,          &
516
 
   rdevel , rtuser , ra     )
517
 
 
518
 
    call cfdivs                                                   &
519
 
    !==========
520
 
 ( idebia , idebra ,                                              &
521
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
522
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
523
 
   nvar   , nscal  , nphas  , ncepdp , ncesmp ,                   &
524
 
   nideve , nrdeve , nituse , nrtuse , iphas  ,                   &
525
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
526
 
   ipnfac , nodfac , ipnfbr , nodfbr , icepdc , icetsm , itypsm , &
527
 
   idevel , ituser , ia     ,                                     &
528
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
529
 
   rtpa   , propce , propfa , propfb ,                            &
530
 
   coefa  , coefb  , ckupdc , smacel ,                            &
531
 
   w12    , w9     , w9     , w8     ,                            &
532
 
!        ------
533
 
   w7     ,                                                       &
534
 
   w1     , w2     , w3     , w4     , w5     , w6     ,          &
535
 
   rdevel , rtuser , ra     )
 
340
 ( nvar   , nscal  , ncepdp , ncesmp ,                            &
 
341
   icepdc , icetsm , itypsm ,                                     &
 
342
   rtpa   , propce , propfa , propfb ,                            &
 
343
   coefa  , coefb  , ckupdc , smacel ,                            &
 
344
   w10    , w8     , w9     , w9     )
 
345
!        ------
 
346
 
 
347
    call cfdivs                                                   &
 
348
    !==========
 
349
 ( nvar   , nscal  , ncepdp , ncesmp ,                            &
 
350
   icepdc , icetsm , itypsm ,                                     &
 
351
   rtpa   , propce , propfa , propfb ,                            &
 
352
   coefa  , coefb  , ckupdc , smacel ,                            &
 
353
   w11    , w9     , w8     , w9     )
 
354
!        ------
 
355
 
 
356
    call cfdivs                                                   &
 
357
    !==========
 
358
 ( nvar   , nscal  , ncepdp , ncesmp ,                            &
 
359
   icepdc , icetsm , itypsm ,                                     &
 
360
   rtpa   , propce , propfa , propfb ,                            &
 
361
   coefa  , coefb  , ckupdc , smacel ,                            &
 
362
   w12    , w9     , w9     , w8     )
 
363
!        ------
536
364
 
537
365
  endif
538
366
 
545
373
  thetv  = 0.d0
546
374
  do isou = 1, 3
547
375
    if(isou.eq.1) then
548
 
      ivar0  = iuiph
 
376
      ivar0  = iu
549
377
      call catsma                                                 &
550
378
      !==========
551
379
 ( ncelet, ncel   , ncesmp , iiun   , iextts , thetv  ,           &
552
380
   icetsm, itypsm(1,ivar0) , volume , rtpa(1,ivar0)   ,           &
553
 
   smacel(1,ivar0), smacel(1,ipr(iphas)),                         &
554
 
   w10   , w1     , w2 )
 
381
   smacel(1,ivar0), smacel(1,ipr)   ,                             &
 
382
   w10   , w1     , w2    )
555
383
      do iel = 1, ncel
556
384
        w10(iel) = w10(iel) + w2(iel)
557
385
      enddo
558
386
 
559
387
    elseif(isou.eq.2) then
560
 
      ivar0  = iviph
 
388
      ivar0  = iv
561
389
      call catsma                                                 &
562
390
      !==========
563
391
 ( ncelet, ncel   , ncesmp , iiun   , iextts , thetv  ,           &
564
392
   icetsm, itypsm(1,ivar0) , volume , rtpa(1,ivar0)   ,           &
565
 
   smacel(1,ivar0), smacel(1,ipr(iphas)),                         &
 
393
   smacel(1,ivar0), smacel(1,ipr)   ,                             &
566
394
   w11   , w1     , w2 )
567
395
      do iel = 1, ncel
568
396
        w11(iel) = w11(iel) + w2(iel)
569
397
      enddo
570
398
 
571
399
    elseif(isou.eq.3) then
572
 
      ivar0  = iwiph
 
400
      ivar0  = iw
573
401
      call catsma                                                 &
574
402
      !==========
575
403
 ( ncelet, ncel   , ncesmp , iiun   , iextts , thetv  ,           &
576
404
   icetsm, itypsm(1,ivar0) , volume , rtpa(1,ivar0)   ,           &
577
 
   smacel(1,ivar0), smacel(1,ipr(iphas)),                         &
578
 
   w12   , w1     , w2 )
 
405
   smacel(1,ivar0), smacel(1,ipr)   ,                             &
 
406
   w12   , w1     , w2     )
579
407
      do iel = 1, ncel
580
408
        w12(iel) = w12(iel) + w2(iel)
581
409
      enddo
604
432
imodif = 0
605
433
call uscfth                                                       &
606
434
!==========
607
 
 ( idebia , idebra ,                                              &
608
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
609
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
610
 
   nvar   , nscal  , nphas  ,                                     &
611
 
   iccfth , imodif , iphas  ,                                     &
612
 
   nideve , nrdeve , nituse , nrtuse ,                            &
613
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
614
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
615
 
   idevel , ituser , ia     ,                                     &
616
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
435
 ( nvar   , nscal  ,                                              &
 
436
   iccfth , imodif ,                                              &
617
437
   dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
618
438
   coefa  , coefb  ,                                              &
619
 
   w1     , w8     , w9     , w10    ,                            &
620
 
!        ------
621
 
   rdevel , rtuser , ra     )
 
439
   w1     , w8     , w9     , w10    )
622
440
 
623
441
! --- Communication de l'entropie
624
 
if(irangp.ge.0) then
625
 
  call parcom (w1)
626
 
  !==========
627
 
endif
628
 
 
629
 
if(iperio.eq.1) then
630
 
  idimte = 0
631
 
  itenso = 0
632
 
  call percom                                                     &
633
 
  !==========
634
 
 ( idimte , itenso ,                                              &
635
 
   w1     , w1     , w1     ,                                     &
636
 
   w1     , w1     , w1     ,                                     &
637
 
   w1     , w1     , w1     )
 
442
if (irangp.ge.0.or.iperio.eq.1) then
 
443
  call synsca(w1)
 
444
  !==========
638
445
endif
639
446
 
640
447
! --- Calcul de dt*Beta/Rho au centre des cellules et affectation a W2
642
449
imodif = 0
643
450
call uscfth                                                       &
644
451
!==========
645
 
 ( idebia , idebra ,                                              &
646
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
647
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
648
 
   nvar   , nscal  , nphas  ,                                     &
649
 
   iccfth , imodif , iphas  ,                                     &
650
 
   nideve , nrdeve , nituse , nrtuse ,                            &
651
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
652
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
653
 
   idevel , ituser , ia     ,                                     &
654
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
452
 ( nvar   , nscal  ,                                              &
 
453
   iccfth , imodif ,                                              &
655
454
   dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
656
455
   coefa  , coefb  ,                                              &
657
 
   w2     , w8     , w9     , w10    ,                            &
658
 
!        ------
659
 
   rdevel , rtuser , ra     )
 
456
   w2     , w8     , w9     , w10    )
660
457
 
661
458
! --- Pour la condition au bord sur l'entropie
662
459
!     COEFA=COEFA(.,ITEMPK) et COEFB=COEFB(.,ITEMPK)
671
468
 
672
469
call viscfa                                                       &
673
470
!==========
674
 
 ( idebia , idebra ,                                              &
675
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
676
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
677
 
   nideve , nrdeve , nituse , nrtuse , imvis1 ,                   &
678
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
679
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
680
 
   idevel , ituser , ia     ,                                     &
681
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
471
 ( imvis1 ,                                                       &
682
472
   w2     ,                                                       &
683
 
   trflms , trflmb ,                                              &
684
 
!        ------   ------
685
 
   rdevel , rtuser , ra     )
 
473
   trflms , trflmb )
686
474
 
687
475
! --- Calcul du flux de diffusion
688
476
 
712
500
 
713
501
call cfbsc3                                                       &
714
502
!==========
715
 
 ( idebia , idebra ,                                              &
716
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
717
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
718
 
   nvar   , nscal  , nphas  ,                                     &
719
 
   nideve , nrdeve , nituse , nrtuse ,                            &
 
503
 ( nvar   , nscal  ,                                              &
720
504
   ivar0  , iconvp , idiffp , nswrgp , imligp , ircflp ,          &
721
505
   ischcp , isstpp , inc    , imrgra , iccocg ,                   &
722
506
   ipp    , iwarnp ,                                              &
723
507
   blencp , epsrgp , climgp , extrap ,                            &
724
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
725
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
726
 
   idevel , ituser , ia     ,                                     &
727
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
728
508
   w1     , coefu(1,1)      , coefu(1,2)      ,                   &
729
509
            coefu(1,1)      , coefu(1,2)      ,                   &
730
510
   trflms , trflmb , trflms , trflmb ,                            &
731
 
   flumas , flumab ,                                              &
732
 
!        ------   ------
733
 
   w2     , w3     , w4     , w8     , w9     , w10    ,          &
734
 
   rdevel , rtuser , ra     )
 
511
   flumas , flumab )
735
512
 
736
513
 
737
514
! 2.3 CALCUL DU FLUX DE MASSE AUX FACES
740
517
! --- Calcul des "vitesses" de convection au centre des cellules
741
518
 
742
519
do iel = 1, ncel
743
 
  w10(iel) = rtpa(iel,iuiph) + dt(iel)*w5(iel)
744
 
  w11(iel) = rtpa(iel,iviph) + dt(iel)*w6(iel)
745
 
  w12(iel) = rtpa(iel,iwiph) + dt(iel)*w7(iel)
 
520
  w10(iel) = rtpa(iel,iu) + dt(iel)*w5(iel)
 
521
  w11(iel) = rtpa(iel,iv) + dt(iel)*w6(iel)
 
522
  w12(iel) = rtpa(iel,iw) + dt(iel)*w7(iel)
746
523
enddo
747
524
 
748
525
! --- Calcul du flux par appel a INIMAS
766
543
  trflmb(ifac) = 1.d0
767
544
enddo
768
545
 
769
 
icliup = iclrtp(iuiph ,icoef)
770
 
iclivp = iclrtp(iviph ,icoef)
771
 
icliwp = iclrtp(iwiph ,icoef)
 
546
icliup = iclrtp(iu ,icoef)
 
547
iclivp = iclrtp(iv ,icoef)
 
548
icliwp = iclrtp(iw ,icoef)
772
549
 
773
550
init   = 0
774
551
!              ^ Il y a deja le flux de diffusion d'entropie dans FLUMAS
777
554
iccocg = 1
778
555
ivar0  = 0
779
556
iflmb0 = 1
780
 
iismph = iisymp+nfabor*(iphas-1)
781
557
nswrgp = nswrgr(ivar)
782
558
imligp = imligr(ivar)
783
559
iwarnp = iwarni(ivar)
789
565
 
790
566
call inimas                                                       &
791
567
!==========
792
 
 ( idebia , idebra ,                                              &
793
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
794
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
795
 
   nvar   , nscal  , nphas  ,                                     &
796
 
   ivar0  , ivar0  , ivar0  , imaspe , iphas  ,                   &
797
 
   nideve , nrdeve , nituse , nrtuse ,                            &
 
568
 ( nvar   , nscal  ,                                              &
 
569
   ivar0  , ivar0  , ivar0  , imaspe ,                            &
798
570
   iflmb0 , init   , inc    , imrgra , iccocg , nswrgp , imligp , &
799
571
   iwarnp , nfecra ,                                              &
800
572
   epsrgp , climgp , extrap ,                                     &
801
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
802
 
   ipnfac , nodfac , ipnfbr , nodfbr , ia(iismph) ,               &
803
 
   idevel , ituser , ia     ,                                     &
804
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
805
573
   w1     , trflmb ,                                              &
806
574
   w10    , w11    , w12    ,                                     &
807
575
   coefa(1,icliup) , coefa(1,iclivp) , coefa(1,icliwp) ,          &
808
576
   trflmb          , trflmb          , trflmb          ,          &
809
 
   flumas , flumab ,                                              &
810
 
!        ------   ------
811
 
   w1     , w2     , w3     , w4     , w5     , w6     ,          &
812
 
   w7     , w8     , w9     , coefu  ,                            &
813
 
   rdevel , rtuser , ra     )
 
577
   flumas , flumab )
 
578
 
 
579
! Free memory
 
580
deallocate(w1, w2, w3)
 
581
deallocate(w4, w5, w6)
 
582
deallocate(w7, w8, w9)
 
583
deallocate(w10, w11, w12)
 
584
 
814
585
 
815
586
!--------
816
587
! FORMATS