← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/base/dttvar.f90

  • Committer: Package Import Robot
  • Author(s): Sylvestre Ledru
  • Date: 2011-11-24 00:00:08 UTC
  • mfrom: (6.1.9 sid)
  • Revision ID: package-import@ubuntu.com-20111124000008-2vo99e38267942q5
Tags: 2.1.0-3
Install a missing file

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/base/dttvar.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 dttvar &
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 , iwarnp ,                   &
36
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
37
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
 
26
 ( nvar   , nscal  , ncepdp , ncesmp ,                            &
 
27
   iwarnp ,                                                       &
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
 
   coefa  , coefb  , ckupdc , smacel ,                            &
43
 
   viscf  , viscb  , dam    , cofbdt , w1     , w2     , w3     , &
44
 
   coefbr , grarox , graroy , graroz , wcf    ,                   &
45
 
   rdevel , rtuser , ra     )
 
30
   coefa  , coefb  , ckupdc , smacel )
46
31
 
47
32
!===============================================================================
48
33
! FONCTION :
61
46
!__________________.____._____.________________________________________________.
62
47
! name             !type!mode ! role                                           !
63
48
!__________________!____!_____!________________________________________________!
64
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
65
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
66
 
! ndim             ! i  ! <-- ! spatial dimension                              !
67
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
68
 
! ncel             ! i  ! <-- ! number of cells                                !
69
 
! nfac             ! i  ! <-- ! number of interior faces                       !
70
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
71
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
72
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
73
 
! nnod             ! i  ! <-- ! number of vertices                             !
74
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
75
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
76
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
77
49
! nvar             ! i  ! <-- ! total number of variables                      !
78
50
! nscal            ! i  ! <-- ! total number of scalars                        !
79
 
! nphas            ! i  ! <-- ! number of phases                               !
80
51
! ncepdp           ! i  ! <-- ! number of cells with head loss                 !
81
52
! ncesmp           ! i  ! <-- ! number of cells with mass source term          !
82
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
83
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
84
53
! iwarnp           ! i  ! <-- ! verbosity                                      !
85
 
! ifacel(2, nfac)  ! ia ! <-- ! interior faces -> cells connectivity           !
86
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
87
 
! ifmfbr(nfabor)   ! ia ! <-- ! boundary face family numbers                   !
88
 
! ifmcel(ncelet)   ! ia ! <-- ! cell family numbers                            !
89
 
! iprfml           ! ia ! <-- ! property numbers per family                    !
90
 
!  (nfml, nprfml)  !    !     !                                                !
91
 
! ipnfac(nfac+1)   ! ia ! <-- ! interior faces -> vertices index (optional)    !
92
 
! nodfac(lndfac)   ! ia ! <-- ! interior faces -> vertices list (optional)     !
93
 
! ipnfbr(nfabor+1) ! ia ! <-- ! boundary faces -> vertices index (optional)    !
94
 
! nodfbr(lndfbr)   ! ia ! <-- ! boundary faces -> vertices list (optional)     !
95
54
! icepdc(ncelet    ! te ! <-- ! numero des ncepdp cellules avec pdc            !
96
55
! icetsm(ncesmp    ! te ! <-- ! numero des cellules a source de masse          !
97
56
! itypsm           ! te ! <-- ! type de source de masse pour les               !
98
57
! (ncesmp,nvar)    !    !     !  variables (cf. ustsma)                        !
99
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
100
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
101
 
! ia(*)            ! ia ! --- ! main integer work array                        !
102
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
103
 
!  (ndim, ncelet)  !    !     !                                                !
104
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
105
 
!  (ndim, nfac)    !    !     !                                                !
106
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
107
 
!  (ndim, nfabor)  !    !     !                                                !
108
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
109
 
!  (ndim, nfac)    !    !     !                                                !
110
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
111
 
!  (ndim, nfabor)  !    !     !                                                !
112
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !
113
 
!  (ndim, nnod)    !    !     !                                                !
114
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !
115
58
! dt(ncelet)       ! ra ! <-- ! time step (per cell)                           !
116
59
! rtp, rtpa        ! ra ! <-- ! calculated variables at cell centers           !
117
60
!  (ncelet, *)     !    !     !  (at current and previous time steps)          !
125
68
! smacel           ! tr ! <-- ! valeur des variables associee a la             !
126
69
! (ncesmp,nvar)    !    !     !  source de masse                               !
127
70
!                  !    !     ! pour ivar=ipr, smacel=flux de masse            !
128
 
! viscf(nfac)      ! tr ! --- ! visc*surface/dist aux faces internes           !
129
 
! viscb(nfabor     ! tr ! --- ! visc*surface/dist aux faces de bord            !
130
 
! dam(ncelet       ! tr ! --- ! tableau de travail pour matrice                !
131
 
! cofbdt(nfabor    ! tr ! --- ! condition limite pas de temps                  !
132
 
! w1,2,3(ncelet    ! tr ! --- ! tableaux de travail                            !
133
 
! graro.(ncelet    ! tr ! --- ! tableaux de travail (iptlro=1)                 !
134
 
! coefbr(nfabor    ! tr ! --- ! tableau de travail (iptlro=1)                  !
135
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
136
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
137
 
! ra(*)            ! ra ! --- ! main real work array                           !
138
71
!__________________!____!_____!________________________________________________!
139
72
 
140
73
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
143
76
!            --- tableau de travail
144
77
!===============================================================================
145
78
 
 
79
!===============================================================================
 
80
! Module files
 
81
!===============================================================================
 
82
 
 
83
use paramx
 
84
use dimens, only: ndimfb
 
85
use numvar
 
86
use cstnum
 
87
use cstphy
 
88
use optcal
 
89
use entsor
 
90
use parall
 
91
use ppppar
 
92
use ppthch
 
93
use ppincl
 
94
use mesh
 
95
 
 
96
!===============================================================================
 
97
 
146
98
implicit none
147
99
 
148
 
!===============================================================================
149
 
! Common blocks
150
 
!===============================================================================
151
 
 
152
 
include "dimfbr.h"
153
 
include "paramx.h"
154
 
include "numvar.h"
155
 
include "cstnum.h"
156
 
include "cstphy.h"
157
 
include "optcal.h"
158
 
include "entsor.h"
159
 
include "parall.h"
160
 
include "ppppar.h"
161
 
include "ppthch.h"
162
 
include "ppincl.h"
163
 
 
164
 
!===============================================================================
165
 
 
166
100
! Arguments
167
101
 
168
 
integer          idbia0 , idbra0
169
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
170
 
integer          nfml   , nprfml
171
 
integer          nnod   , lndfac , lndfbr , ncelbr
172
 
integer          nvar   , nscal  , nphas
 
102
integer          nvar   , nscal
173
103
integer          ncepdp , ncesmp
174
 
integer          nideve , nrdeve , nituse , nrtuse , iwarnp
 
104
integer          iwarnp
175
105
 
176
 
integer          ifacel(2,nfac) , ifabor(nfabor)
177
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
178
 
integer          iprfml(nfml,nprfml)
179
 
integer          ipnfac(nfac+1), nodfac(lndfac)
180
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr)
181
106
integer          icepdc(ncepdp)
182
107
integer          icetsm(ncesmp), itypsm(ncesmp,nvar)
183
 
integer          idevel(nideve), ituser(nituse)
184
 
integer          ia(*)
185
108
 
186
 
double precision xyzcen(ndim,ncelet)
187
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
188
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
189
 
double precision xyznod(ndim,nnod), volume(ncelet)
190
109
double precision dt(ncelet), rtp(ncelet,*), rtpa(ncelet,*)
191
110
double precision propce(ncelet,*)
192
111
double precision propfa(nfac,*), propfb(ndimfb,*)
193
112
double precision coefa(ndimfb,*), coefb(ndimfb,*)
194
113
double precision ckupdc(ncepdp,6), smacel(ncesmp,nvar)
195
 
double precision viscf(nfac), viscb(nfabor)
196
 
double precision dam(ncelet ), cofbdt(nfabor)
197
 
double precision w1(ncelet), w2(ncelet), w3(ncelet)
198
 
!   Attention, COEFBR n'est defini  que pour IPTLRO = 1
199
 
double precision coefbr(nfabor)
200
 
!   Attention, GRAROX, GRAROY, GRAROZ ne sont
201
 
!   definis que pour IPTLRO = 1 ou en compressible
202
 
double precision grarox(ncelet),graroy(ncelet),graroz(ncelet)
203
 
!   Attention, WCF n'est defini qu'en compressible
204
 
double precision wcf(ncelet)
205
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
 
114
 
206
115
 
207
116
! Local variables
208
117
 
209
118
character*8      cnom
210
 
integer          idebia, idebra
 
119
 
211
120
integer          ifac, iel, icfmax, icfmin, idiff0, iconv0, isym
212
121
integer          modntl
213
 
integer          iphas, iuiph, ipcvis, ipcvst
 
122
integer          ipcvis, ipcvst
214
123
integer          iflmas, iflmab
215
124
integer          icou, ifou , icoucf
216
125
integer          inc, iccocg
217
 
integer          nswrgp, imligp , iphydp
 
126
integer          nswrgp, imligp
218
127
integer          ipcrom, ipbrom, iivar
219
128
integer          nbrval
220
129
integer          ipccou, ipcfou
 
130
 
221
131
double precision epsrgp, climgp, extrap
222
132
double precision cfmax,cfmin, coufou, w1min, w2min, w3min
223
133
double precision unpvdt, rom
224
134
double precision xyzmax(3), xyzmin(3)
225
135
double precision dtsdtm,dtsdt0
226
136
 
 
137
double precision, allocatable, dimension(:) :: viscf, viscb
 
138
double precision, allocatable, dimension(:) :: dam
 
139
double precision, allocatable, dimension(:) :: wcf
 
140
double precision, allocatable, dimension(:) :: cofbdt, coefbr
 
141
double precision, allocatable, dimension(:,:) :: grad
 
142
double precision, allocatable, dimension(:) :: w1, w2, w3
 
143
 
227
144
!===============================================================================
228
145
 
229
146
!===============================================================================
230
147
! 0.  INITIALISATION
231
148
!===============================================================================
232
149
 
233
 
idebia = idbia0
234
 
idebra = idbra0
235
 
 
236
 
iphas   = 1
237
 
iuiph   = iu(iphas)
238
 
iflmas  = ipprof(ifluma(iuiph))
239
 
iflmab  = ipprob(ifluma(iuiph))
240
 
ipcvis  = ipproc(iviscl(iphas))
241
 
ipcvst  = ipproc(ivisct(iphas))
242
 
ipcrom  = ipproc(irom  (iphas))
243
 
ipbrom  = ipprob(irom  (iphas))
244
 
ipccou  = ipproc(icour (iphas))
245
 
ipcfou  = ipproc(ifour (iphas))
 
150
! Allocate temporary arrays for the time-step resolution
 
151
allocate(viscf(nfac), viscb(nfabor))
 
152
allocate(dam(ncelet))
 
153
allocate(cofbdt(nfabor))
 
154
 
 
155
! Allocate other arrays, depending on user options
 
156
if (ippmod(icompf).ge.0) then
 
157
  allocate(wcf(ncelet))
 
158
endif
 
159
 
 
160
! Allocate work arrays
 
161
allocate(w1(ncelet), w2(ncelet), w3(ncelet))
 
162
 
 
163
 
 
164
iflmas  = ipprof(ifluma(iu))
 
165
iflmab  = ipprob(ifluma(iu))
 
166
ipcvis  = ipproc(iviscl)
 
167
ipcvst  = ipproc(ivisct)
 
168
ipcrom  = ipproc(irom  )
 
169
ipbrom  = ipprob(irom  )
 
170
ipccou  = ipproc(icour )
 
171
ipcfou  = ipproc(ifour )
246
172
 
247
173
if(ntlist.gt.0) then
248
174
  modntl = mod(ntcabs,ntlist)
253
179
endif
254
180
 
255
181
if (                                                              &
256
 
   .not. ( iconv(iuiph).ge.1.and.                                 &
 
182
   .not. ( iconv(iu).ge.1.and.                                 &
257
183
           (iwarnp.ge.2.or.modntl.eq.0) ) .and.                   &
258
 
   .not. ( idiff(iuiph).ge.1.and.                                 &
 
184
   .not. ( idiff(iu).ge.1.and.                                 &
259
185
           (iwarnp.ge.2.or.modntl.eq.0) ) .and.                   &
260
186
   .not. ( ippmod(icompf).ge.0.and.                               &
261
187
           (iwarnp.ge.2.or.modntl.eq.0) ) .and.                   &
262
188
   .not. ( idtvar.eq.1.or.idtvar.eq.2.or.                         &
263
189
           ( (iwarnp.ge.2.or.modntl.eq.0).and.                    &
264
 
             (idiff(iuiph).ge.1.or.iconv(iuiph).ge.1              &
 
190
             (idiff(iu).ge.1.or.iconv(iu).ge.1              &
265
191
                               .or.ippmod(icompf).ge.0)  ) )      &
266
192
   ) then
267
193
 
293
219
 
294
220
    call cfdttv                                                   &
295
221
    !==========
296
 
 ( idebia , idebra ,                                              &
297
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
298
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
299
 
   nvar   , nscal  , nphas  , ncepdp , ncesmp ,                   &
300
 
   nideve , nrdeve , nituse , nrtuse , iwarnp ,                   &
301
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
302
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
 
222
 ( nvar   , nscal  , ncepdp , ncesmp ,                            &
 
223
   iwarnp ,                                                       &
303
224
   icepdc , icetsm , itypsm ,                                     &
304
 
   idevel , ituser , ia     ,                                     &
305
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
306
225
   dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
307
226
   coefa  , coefb  , ckupdc , smacel ,                            &
308
227
   wcf    ,                                                       &
309
228
!        ---
310
 
   viscf  , viscb  , cofbdt , w1     , w2     , dam    ,          &
311
 
   grarox , graroy , graroz ,                                     &
312
 
   rdevel , rtuser , ra     )
 
229
   viscf  , viscb  , cofbdt )
313
230
 
314
231
  endif
315
232
 
323
240
 
324
241
!     "VITESSE" DE DIFFUSION FACETTE
325
242
 
326
 
if( idiff(iuiph).ge. 1 ) then
 
243
if( idiff(iu).ge. 1 ) then
327
244
  do iel = 1, ncel
328
245
    w1    (iel) = propce(iel,ipcvis)                              &
329
 
                                +idifft(iuiph)*propce(iel,ipcvst)
 
246
                                +idifft(iu)*propce(iel,ipcvst)
330
247
  enddo
331
248
  call viscfa                                                     &
332
249
  !==========
333
 
 ( idebia , idebra ,                                              &
334
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
335
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
336
 
   nideve , nrdeve , nituse , nrtuse , imvisf ,                   &
337
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
338
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
339
 
   idevel , ituser , ia     ,                                     &
340
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
250
 ( imvisf ,                                                       &
341
251
   w1     ,                                                       &
342
 
   viscf  , viscb  ,                                              &
343
 
   rdevel , rtuser , ra     )
 
252
   viscf  , viscb  )
344
253
 
345
254
else
346
255
  do ifac = 1, nfac
366
275
 
367
276
  if (iptlro.eq.1) then
368
277
 
 
278
    ! Allocate a temporary array for the gradient calculation
 
279
    allocate(grad(ncelet,3))
 
280
    allocate(coefbr(nfabor))
 
281
 
369
282
    do ifac = 1, nfabor
370
283
      coefbr(ifac) = 0.d0
371
284
    enddo
372
285
 
373
 
    nswrgp = nswrgr(ipr(iphas))
374
 
    imligp = imligr(ipr(iphas))
375
 
    iwarnp = iwarni(ipr(iphas))
376
 
    epsrgp = epsrgr(ipr(iphas))
377
 
    climgp = climgr(ipr(iphas))
 
286
    nswrgp = nswrgr(ipr)
 
287
    imligp = imligr(ipr)
 
288
    iwarnp = iwarni(ipr)
 
289
    epsrgp = epsrgr(ipr)
 
290
    climgp = climgr(ipr)
378
291
    extrap = 0.d0
379
 
    iphydp = 0
380
292
 
381
293
    iivar = 0
382
294
    inc   = 1
384
296
 
385
297
    call grdcel                                                   &
386
298
    !==========
387
 
 ( idebia , idebra ,                                              &
388
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
389
 
   nnod   , lndfac , lndfbr , ncelbr , nphas  ,                   &
390
 
   nideve , nrdeve , nituse , nrtuse ,                            &
391
 
   iivar  , imrgra , inc    , iccocg , nswrgp , imligp , iphydp , &
 
299
 ( iivar  , imrgra , inc    , iccocg , nswrgp , imligp ,          &
392
300
   iwarnp , nfecra , epsrgp , climgp , extrap ,                   &
393
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
394
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
395
 
   idevel , ituser , ia     ,                                     &
396
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
397
 
   w1     , w1     , w1     ,                                     &
398
301
   propce(1,ipcrom), propfb(1,ipbrom), coefbr ,                   &
399
 
   grarox , graroy , graroz ,                                     &
400
 
!        ------   ------   ------
401
 
   w1     , w2     , dam    ,                                     &
402
 
   rdevel , rtuser , ra     )
 
302
   grad   )
403
303
 
404
304
    do iel = 1, ncel
405
 
      w3(iel) = (grarox(iel)*gx + graroy(iel)*gy + graroz(iel)*gz)&
 
305
      w3(iel) = (grad(iel,1)*gx + grad(iel,2)*gy + grad(iel,3)*gz)&
406
306
           /propce(iel,ipcrom)
407
307
      w3(iel) = 1.d0/sqrt(max(epzero,w3(iel)))
408
308
 
409
309
    enddo
410
310
 
 
311
    ! Free memory
 
312
    deallocate(grad)
 
313
    deallocate(coefbr)
 
314
 
411
315
!     On met le nombre de clippings a 0 (il le restera pour IDTVAR=0)
412
316
    nclptr = 0
413
317
 
422
326
! 4.1.1 LIMITATION PAR LE COURANT
423
327
! =============================
424
328
 
425
 
    if ( coumax.gt.0.d0.and.iconv(iuiph).ge.1 ) then
 
329
    if ( coumax.gt.0.d0.and.iconv(iu).ge.1 ) then
426
330
 
427
331
!     ICOU = 1 marque l'existence d'une limitation par le COURANT
428
332
      icou = 1
434
338
!     Matrice a priori non symetrique
435
339
      isym = 2
436
340
 
437
 
      call matrdt                                                 &
 
341
      call matrdt &
438
342
      !==========
439
 
 ( idebia , idebra ,                                              &
440
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
441
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
442
 
   nideve , nrdeve , nituse , nrtuse ,                            &
443
 
   iconv(iuiph)    , idiff0          , isym   ,                   &
444
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
445
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
446
 
   idevel , ituser , ia     ,                                     &
447
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
343
 ( iconv(iu)    , idiff0          , isym   ,                      &
448
344
   cofbdt , propfa(1,iflmas), propfb(1,iflmab), viscf  , viscb  , &
449
 
   dam    ,                                                       &
450
 
   rdevel , rtuser , ra     )
 
345
   dam    )
451
346
 
452
347
      do iel = 1, ncel
453
348
        rom = propce(iel,ipcrom)
482
377
! 4.1.2 LIMITATION PAR LE FOURIER
483
378
! =============================
484
379
 
485
 
    if ( foumax.gt.0.d0.and.idiff(iuiph).ge.1 ) then
 
380
    if ( foumax.gt.0.d0.and.idiff(iu).ge.1 ) then
486
381
 
487
382
!     IFOU = 1 marque l'existence d'une limitation par le FOURIER
488
383
      ifou = 1
494
389
!     Matrice a priori symetrique
495
390
      isym = 1
496
391
 
497
 
      call matrdt                                                 &
 
392
      call matrdt &
498
393
      !==========
499
 
 ( idebia , idebra ,                                              &
500
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
501
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
502
 
   nideve , nrdeve , nituse , nrtuse ,                            &
503
 
   iconv0          , idiff(iuiph)    , isym   ,                   &
504
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
505
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
506
 
   idevel , ituser , ia     ,                                     &
507
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
394
 ( iconv0          , idiff(iu)    , isym   ,                      &
508
395
   cofbdt , propfa(1,iflmas), propfb(1,iflmab), viscf  , viscb  , &
509
 
   dam    ,                                                       &
510
 
   rdevel , rtuser , ra     )
 
396
   dam    )
511
397
 
512
398
      do iel = 1, ncel
513
399
        rom = propce(iel,ipcrom)
725
611
! 4.2  CALCUL DU NOMBRE DE COURANT POUR AFFICHAGE
726
612
!===============================================================================
727
613
 
728
 
  if ( iconv(iuiph).ge.1.and.                                     &
 
614
  if ( iconv(iu).ge.1.and.                                     &
729
615
       (iwarnp.ge.2.or.modntl.eq.0) ) then
730
616
 
731
617
    idiff0 = 0
737
623
 
738
624
    isym = 2
739
625
 
740
 
    call matrdt                                                   &
 
626
    call matrdt &
741
627
    !==========
742
 
 ( idebia , idebra ,                                              &
743
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
744
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
745
 
   nideve , nrdeve , nituse , nrtuse ,                            &
746
 
   iconv(iuiph)    , idiff0          , isym   ,                   &
747
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
748
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
749
 
   idevel , ituser , ia     ,                                     &
750
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
628
 ( iconv(iu)    , idiff0          , isym   ,                      &
751
629
   cofbdt , propfa(1,iflmas), propfb(1,iflmab), viscf  , viscb  , &
752
 
   dam    ,                                                       &
753
 
   rdevel , rtuser , ra     )
 
630
   dam    )
754
631
 
755
632
    do iel = 1, ncel
756
633
      rom = propce(iel,ipcrom)
817
694
! 4.3  CALCUL DU NOMBRE DE FOURIER POUR AFFICHAGE
818
695
!===============================================================================
819
696
 
820
 
  if ( idiff(iuiph).ge.1.and.                                     &
 
697
  if ( idiff(iu).ge.1.and.                                     &
821
698
       (iwarnp.ge.2.or.modntl.eq.0) ) then
822
699
 
823
700
    iconv0 = 0
829
706
 
830
707
    isym = 1
831
708
 
832
 
    call matrdt                                                   &
 
709
    call matrdt &
833
710
    !==========
834
 
 ( idebia , idebra ,                                              &
835
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
836
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
837
 
   nideve , nrdeve , nituse , nrtuse ,                            &
838
 
   iconv0          , idiff(iuiph)    , isym   ,                   &
839
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
840
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
841
 
   idevel , ituser , ia     ,                                     &
842
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
711
 ( iconv0          , idiff(iu)    , isym   ,                      &
843
712
   cofbdt , propfa(1,iflmas), propfb(1,iflmab), viscf  , viscb  , &
844
 
   dam    ,                                                       &
845
 
   rdevel , rtuser , ra     )
 
713
   dam    )
846
714
 
847
715
    do iel = 1, ncel
848
716
      rom = propce(iel,ipcrom)
913
781
!       afficher la contrainte liee a la masse volumique)
914
782
 
915
783
  if ( (iwarnp.ge.2.or.modntl.eq.0).and.                          &
916
 
      (idiff(iuiph).ge.1.or.iconv(iuiph).ge.1)                    &
 
784
      (idiff(iu).ge.1.or.iconv(iu).ge.1)                    &
917
785
      .and.(ippmod(icompf).lt.0)               ) then
918
786
 
919
787
    CNOM   =' COU/FOU'
923
791
! MATRICE A PRIORI NON SYMETRIQUE
924
792
 
925
793
    isym = 1
926
 
    if (iconv(iuiph).gt.0) isym = 2
 
794
    if (iconv(iu).gt.0) isym = 2
927
795
 
928
 
    call matrdt                                                   &
 
796
    call matrdt &
929
797
    !==========
930
 
 ( idebia , idebra ,                                              &
931
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
932
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
933
 
   nideve , nrdeve , nituse , nrtuse ,                            &
934
 
   iconv(iuiph)    , idiff(iuiph)    , isym   ,                   &
935
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
936
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
937
 
   idevel , ituser , ia     ,                                     &
938
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
798
 ( iconv(iu)    , idiff(iu)    , isym   ,                         &
939
799
   cofbdt , propfa(1,iflmas), propfb(1,iflmab), viscf  , viscb  , &
940
 
   dam    ,                                                       &
941
 
   rdevel , rtuser , ra     )
 
800
   dam    )
942
801
 
943
802
    do iel = 1, ncel
944
803
      rom = propce(iel,ipcrom)
1073
932
else
1074
933
 
1075
934
  isym = 1
1076
 
  if (iconv(iuiph).gt.0) isym = 2
 
935
  if (iconv(iu).gt.0) isym = 2
1077
936
 
1078
 
  call matrdt                                                     &
 
937
  call matrdt &
1079
938
  !==========
1080
 
 ( idebia , idebra ,                                              &
1081
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1082
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
1083
 
   nideve , nrdeve , nituse , nrtuse ,                            &
1084
 
   iconv(iuiph)    , idiff(iuiph)    , isym,                      &
1085
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
1086
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
1087
 
   idevel , ituser , ia     ,                                     &
1088
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
1089
 
   coefb(1,iuiph)  , propfa(1,iflmas), propfb(1,iflmab),          &
 
939
 ( iconv(iu)    , idiff(iu)    , isym,                            &
 
940
   coefb(1,iu)  , propfa(1,iflmas), propfb(1,iflmab),             &
1090
941
                                                viscf  , viscb  , &
1091
 
   dt     , rdevel , rtuser , ra )
 
942
   dt     )
1092
943
 
1093
944
  do iel = 1, ncel
1094
 
    dt(iel) = relaxv(iuiph)*propce(iel,ipcrom)                    &
 
945
    dt(iel) = relaxv(iu)*propce(iel,ipcrom)                    &
1095
946
         *volume(iel)/max(dt(iel),epzero)
1096
947
  enddo
1097
948
 
1098
949
endif
1099
950
 
 
951
! Free memory
 
952
deallocate(viscf, viscb)
 
953
deallocate(dam)
 
954
deallocate(cofbdt)
 
955
if (allocated(wcf)) deallocate(wcf)
 
956
deallocate(w1, w2, w3)
 
957
 
1100
958
!--------
1101
959
! FORMATS
1102
960
!--------