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

« back to all changes in this revision

Viewing changes to src/base/tridim.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:
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 tridim &
29
24
!================
30
25
 
31
 
 ( idbia0 , idbra0 , itrale ,                                     &
32
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
33
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
34
 
   nvar   , nscal  , nphas  ,                                     &
35
 
   nideve , nrdeve , nituse , nrtuse ,                            &
36
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
37
 
   ipnfac , nodfac , ipnfbr , nodfbr , isostd ,                   &
38
 
   idevel , ituser , ia     ,                                     &
39
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
40
 
   dt     , rtpa   , rtp    , propce , propfa , propfb ,          &
41
 
   tslagr , coefa  , coefb  , frcxt  ,                            &
42
 
   rdevel , rtuser ,                                              &
43
 
   ra     )
 
26
 ( itrale ,                                                       &
 
27
   nvar   , nscal  ,                                              &
 
28
   isostd ,                                                       &
 
29
   dt     , tpucou , rtpa   , rtp    , propce , propfa , propfb , &
 
30
   tslagr , coefa  , coefb  , frcxt  )
44
31
 
45
32
!===============================================================================
46
33
! FONCTION :
54
41
!__________________.____._____.________________________________________________.
55
42
! name             !type!mode ! role                                           !
56
43
!__________________!____!_____!________________________________________________!
57
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
58
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
59
44
! itrale           ! e  ! <-- ! numero d'iteration pour l'ale                  !
60
 
! ndim             ! i  ! <-- ! spatial dimension                              !
61
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
62
 
! ncel             ! i  ! <-- ! number of cells                                !
63
 
! nfac             ! i  ! <-- ! number of interior faces                       !
64
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
65
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
66
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
67
 
! nnod             ! i  ! <-- ! number of vertices                             !
68
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
69
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
70
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
71
45
! nvar             ! i  ! <-- ! total number of variables                      !
72
46
! nscal            ! i  ! <-- ! total number of scalars                        !
73
 
! nphas            ! i  ! <-- ! number of phases                               !
74
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
75
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
76
 
! ifacel(2, nfac)  ! ia ! <-- ! interior faces -> cells connectivity           !
77
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
78
 
! ifmfbr(nfabor)   ! ia ! <-- ! boundary face family numbers                   !
79
 
! ifmcel(ncelet)   ! ia ! <-- ! cell family numbers                            !
80
 
! iprfml           ! ia ! <-- ! property numbers per family                    !
81
 
!  (nfml, nprfml)  !    !     !                                                !
82
 
! ipnfac           ! te ! <-- ! position du premier noeud de chaque            !
83
 
!   (nfac+1)       !    !     !  face interne dans nodfac (optionnel)          !
84
 
! nodfac           ! te ! <-- ! connectivite faces internes/noeuds             !
85
 
!   (lndfac)       !    !     !  (optionnel)                                   !
86
 
! ipnfbr           ! te ! <-- ! position du premier noeud de chaque            !
87
 
!   (nfabor+1)     !    !     !  face de bord dans nodfbr (optionnel)          !
88
 
! nodfbr           ! te ! <-- ! connectivite faces de bord/noeuds              !
89
 
!   (lndfbr)       !    !     !  (optionnel)                                   !
90
47
! isostd           ! te ! <-- ! indicateur de sortie standard                  !
91
48
!    (nfabor+1)    !    !     !  +numero de la face de reference               !
92
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
93
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
94
 
! ia(*)            ! ia ! --- ! main integer work array                        !
95
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
96
 
!  (ndim, ncelet)  !    !     !                                                !
97
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
98
 
!  (ndim, nfac)    !    !     !                                                !
99
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
100
 
!  (ndim, nfabor)  !    !     !                                                !
101
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
102
 
!  (ndim, nfac)    !    !     !                                                !
103
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
104
 
!  (ndim, nfabor)  !    !     !                                                !
105
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !
106
 
!  (ndim, nnod)    !    !     !                                                !
107
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !
108
49
! dt(ncelet)       ! ra ! <-- ! time step (per cell)                           !
 
50
! tpucou(ncelet,3) ! ra ! <-- ! velocity-pressure coupling                     !
109
51
! rtp, rtpa        ! ra ! <-- ! calculated variables at cell centers           !
110
52
!  (ncelet, *)     !    !     !  (at current and previous time steps)          !
111
53
! propce(ncelet, *)! ra ! <-- ! physical properties at cell centers            !
115
57
!  (nfabor, *)     !    !     !                                                !
116
58
! tslagr           ! tr ! <-- ! terme de couplage retour du                    !
117
59
!(ncelet,*)        !    !     !     lagrangien                                 !
118
 
! frcxt(ncelet,    ! tr ! <-- ! force exterieure generant la pression          !
119
 
!   3,nphas)       !    !     !  hydrostatique                                 !
120
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
121
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
122
 
! ra(*)            ! ra ! --- ! main real work array                           !
 
60
! frcxt(ncelet,3)  ! tr ! <-- ! force exterieure generant la pression          !
 
61
!                  !    !     !  hydrostatique                                 !
123
62
!__________________!____!_____!________________________________________________!
124
63
 
125
64
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
126
65
!            L (LOGIQUE)   .. ET TYPES COMPOSES (EX : TR TABLEAU REEL)
127
66
!     MODE : <-- donnee, --> resultat, <-> Donnee modifiee
128
67
!            --- tableau de travail
 
68
!===============================================================================
 
69
 
 
70
!===============================================================================
 
71
! Module files
 
72
!===============================================================================
 
73
 
 
74
use paramx
 
75
use numvar
 
76
use optcal
 
77
use entsor
 
78
use cstphy
 
79
use cstnum
 
80
use pointe
 
81
use albase
 
82
use alstru
 
83
use alaste
 
84
use parall
 
85
use period
 
86
use ppppar
 
87
use ppthch
 
88
use ppincl
 
89
use cpincl
 
90
use coincl
 
91
use atincl
 
92
use lagpar
 
93
use lagdim
 
94
use lagran
 
95
use vorinc
 
96
use ihmpre
 
97
use radiat
 
98
use cplsat
 
99
use ppcpfu
 
100
use mesh
 
101
 
 
102
! les " use pp* " ne servent que pour recuperer le pointeur IIZFPP
129
103
 
130
104
!===============================================================================
131
105
 
132
106
implicit none
133
107
 
134
 
!===============================================================================
135
 
! Common blocks
136
 
!===============================================================================
137
 
 
138
 
include "paramx.h"
139
 
include "numvar.h"
140
 
include "optcal.h"
141
 
include "entsor.h"
142
 
include "cstphy.h"
143
 
include "cstnum.h"
144
 
include "pointe.h"
145
 
include "albase.h"
146
 
include "alstru.h"
147
 
include "alaste.h"
148
 
include "period.h"
149
 
include "parall.h"
150
 
include "ppppar.h"
151
 
include "ppthch.h"
152
 
include "ppincl.h"
153
 
include "cpincl.h"
154
 
include "coincl.h"
155
 
include "atincl.h"
156
 
include "lagpar.h"
157
 
include "lagdim.h"
158
 
include "lagran.h"
159
 
include "vortex.h"
160
 
include "ihmpre.h"
161
 
include "matiss.h"
162
 
include "radiat.h"
163
 
include "cplsat.h"
164
 
 
165
 
! les includes pp* ne servent que pour recuperer le pointeur IIZFPP
166
 
 
167
 
!===============================================================================
168
 
 
169
108
! Arguments
170
109
 
171
 
integer          idbia0 , idbra0 , itrale
172
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
173
 
integer          nfml   , nprfml
174
 
integer          nnod   , lndfac , lndfbr , ncelbr
175
 
integer          nvar   , nscal  , nphas
176
 
integer          nideve , nrdeve , nituse , nrtuse
177
 
 
178
 
integer          ifacel(2,nfac) , ifabor(nfabor)
179
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
180
 
integer          iprfml(nfml,nprfml)
181
 
integer          ipnfac(nfac+1), nodfac(lndfac)
182
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr)
183
 
integer          isostd(nfabor+1,nphas)
184
 
integer          idevel(nideve), ituser(nituse)
185
 
integer          ia(*)
186
 
 
187
 
double precision xyzcen(ndim,ncelet)
188
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
189
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
190
 
double precision xyznod(ndim,nnod), volume(ncelet)
191
 
double precision dt(ncelet), rtp(ncelet,*), rtpa(ncelet,*)
 
110
integer          itrale
 
111
integer          nvar   , nscal
 
112
 
 
113
integer          isostd(nfabor+1)
 
114
 
 
115
double precision dt(ncelet), tpucou(ncelet,3), rtp(ncelet,*), rtpa(ncelet,*)
192
116
double precision propce(ncelet,*)
193
117
double precision propfa(nfac,*), propfb(nfabor,*)
194
118
double precision tslagr(ncelet,*)
195
119
double precision coefa(nfabor,*), coefb(nfabor,*)
196
 
double precision frcxt(ncelet,3,nphas)
197
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
 
120
double precision frcxt(ncelet,3)
198
121
 
199
122
! Local variables
200
123
 
201
 
integer          idebia, idebra
202
 
integer          idbia1, idbra1
203
 
integer          ifinia, ifinra, ifnia1, ifnra1
204
124
integer          iel   , ifac  , inod  , ivar  , iscal , iappel
205
125
integer          ncp   , ncv   , iok
206
126
integer          iicodc, ircodc
207
 
integer          icoefu, irijip, ihbord, itbord
208
 
integer          idtr  , iviscf, iviscb, ivisfi, ivisbi, iiptot
209
 
integer          idam  , ixam
210
 
integer          icofbd
211
 
integer          idrtp , igrdp , ismbr , irovsd
212
 
integer          itinsk, itinse, idivu , iprv2f
213
 
integer          iw1   , iw2   , iw3   , iw4   , iw5   , iw6
214
 
integer          iw7   , iw8   , iw9   , iw10  , iw11  , iw12
215
 
integer          ixmij
216
 
integer          ifrchy, idfrhy, idfrcx
217
 
integer          igrdvt, iprodu, igrarx, igrary, igrarz
218
 
integer          iesflm, iesflb
219
 
integer          itrava, iximpa, iuvwk
 
127
integer          ihbord, itbord
 
128
integer          iiptot
220
129
integer          nbccou
221
 
integer          icofbr
222
130
integer          ntrela
223
131
 
224
132
integer          isvhb , isvtb
225
 
integer          iphas , kphas , ii    , jj    , ippcp , ientha, ippcv
226
 
integer          ikiph , ieiph , iomiph
227
 
integer          iuiph , iviph , iwiph , ipriph, iphiph, iphass
228
 
integer          ir11ip, ir22ip, ir33ip, ir12ip, ir13ip, ir23ip
 
133
integer          ii    , jj    , ippcp , ientha, ippcv
229
134
integer          ipcrom, ipcroa
230
 
integer          iprnew, idimte, itenso
231
 
integer          ifinib, ifinrb, iiifap
 
135
integer          idimte, itenso
232
136
integer          iflua , iflub
233
 
integer          icoax , icobx , icoay , icoby , icoaz , icobz
234
 
integer          iqfx  , iqfy  , iqfz  , icoefq
235
 
integer          iirho , iirhob, icoefx
236
 
integer          irtdp , idrtdp, icofay, icofby, iismph
237
 
integer          iisoth, itext , itint , itek
238
 
integer          icorua, icorub, iflxma, iflxmb
239
 
integer          iterns, inslst, icvrge, iuetbo, ivsvdr
240
 
integer          iwflms, iwflmb
241
 
integer          iwcf  , iph   , iflmas, iflmab
 
137
integer          iterns, inslst, icvrge, ivsvdr
 
138
integer          iflmas, iflmab
242
139
integer          italim, itrfin, itrfup, ineefl
243
 
integer          iflalf, iflalb, iprale, icoale
244
 
integer          maxelt, ils, iilzfb, nbzfmx, nozfmx, iqcalc
 
140
integer          nbzfmx, nozfmx
245
141
 
246
142
double precision cpcst , tditot, tdist2, tdist1, cvcst
247
 
double precision ro0iph, p0iph, pr0iph, xxp0, xyp0, xzp0
248
 
double precision relaxk, relaxe, relaxw
 
143
double precision xxp0, xyp0, xzp0
 
144
double precision relaxk, relaxe, relaxw, relaxn
249
145
double precision ctheta, stheta, omgnrm, rrotgb(3,3)
250
146
 
251
147
integer          ipass
255
151
integer          infpar
256
152
save             infpar
257
153
 
 
154
integer, allocatable, dimension(:,:) :: icodcl
 
155
integer, allocatable, dimension(:) :: ilzfbr
 
156
 
 
157
double precision, allocatable, dimension(:,:) :: uvwk, ximpa, trava
 
158
double precision, allocatable, dimension(:,:,:) :: ximpav
 
159
double precision, allocatable, dimension(:) :: flmalf, flmalb, xprale
 
160
double precision, allocatable, dimension(:,:) :: cofale
 
161
double precision, allocatable, dimension(:) :: qcalc
 
162
double precision, allocatable, dimension(:,:,:) :: rcodcl
 
163
double precision, allocatable, dimension(:) :: hbord, tbord
 
164
double precision, allocatable, dimension(:) :: visvdr
 
165
double precision, allocatable, dimension(:) :: prdv2f
 
166
 
258
167
!===============================================================================
259
168
 
260
169
 
262
171
! 1.  INITIALISATION
263
172
!===============================================================================
264
173
 
265
 
if(iwarni(iu(1)).ge.1) then
 
174
if(iwarni(iu).ge.1) then
266
175
  write(nfecra,1000)
267
176
endif
268
177
 
269
 
idebia = idbia0
270
 
idebra = idbra0
271
 
 
272
 
maxelt = max(ncelet, nfac, nfabor)
273
178
 
274
179
ipass = ipass + 1
275
180
 
276
181
! --- Indicateur de stockage d'un scalaire et de son coef
277
 
!      d'echange associe.
 
182
!     d'echange associe.
278
183
!     Pour le moment, on stocke uniquement dans le cas couplage SYRTHES.
279
 
!     ISVTB donne le numero du scalaire (on suppose qu'il n'y en a
280
 
!       qu'un).
 
184
!     ISVTB donne le numero du scalaire (on suppose qu'il n'y en a qu'un).
281
185
!     Dans le cas ou on a un couplage avec le module thermique 1D en paroi,
282
186
!     on utilise le meme scalaire que celui qui sert a Syrthes (s'il y a
283
187
!     couplage Syrthes), sinon on stocke le scalaire thermique de la phase 1.
296
200
endif
297
201
 
298
202
if ((nfpt1t.gt.0).and.(nbccou.le.0)) then
299
 
  iphas = 1
300
 
  isvhb = iscalt(iphas)
301
 
  isvtb = iscalt(iphas)
 
203
  isvhb = iscalt
 
204
  isvtb = iscalt
302
205
endif
303
206
 
304
207
!     Si la distance a la paroi doit etre mise a jour, on l'initialise a GRAND
306
209
if(ipass.eq.1.and.ineedy.eq.1.and.abs(icdpar).eq.1.and.           &
307
210
                                  imajdy.eq.0) then
308
211
  do iel = 1, ncel
309
 
    ra(idipar+iel-1) = grand
 
212
    dispar(iel) = grand
310
213
  enddo
311
214
endif
312
215
 
325
228
if( ntcabs.le.2 .and. isuite.eq.0 .and. iphydr.eq.0               &
326
229
                .and. ippmod(icompf).lt.0           ) then
327
230
 
328
 
  if(iwarni(ipr(1)).ge.2) then
 
231
  if(iwarni(ipr).ge.2) then
329
232
    write(nfecra,2000) ntcabs
330
233
  endif
331
 
  do iphas = 1, nphas
332
 
    iprnew = 1
333
 
    if(iphas.gt.1) then
334
 
      do kphas = 1, iphas-1
335
 
        if(ipr(iphas).eq.ipr(kphas)) then
336
 
          iprnew = 0
337
 
        endif
338
 
      enddo
339
 
    endif
340
 
    if(iprnew.eq.1) then
341
 
      iiptot = ipproc(iprtot(iphas))
342
 
      ro0iph = ro0  (iphas)
343
 
      p0iph  = p0   (iphas)
344
 
      pr0iph = pred0(iphas)
345
 
      xxp0   = xyzp0(1,iphas)
346
 
      xyp0   = xyzp0(2,iphas)
347
 
      xzp0   = xyzp0(3,iphas)
348
 
      do iel = 1, ncel
349
 
        rtp(iel,ipr(iphas)) = pr0iph
350
 
        propce(iel,iiptot) = p0iph                                &
351
 
             + ro0iph*( gx*(xyzcen(1,iel)-xxp0)                   &
352
 
                      + gy*(xyzcen(2,iel)-xyp0)                   &
353
 
                      + gz*(xyzcen(3,iel)-xzp0) )
354
 
      enddo
355
 
    endif
 
234
  iiptot = ipproc(iprtot)
 
235
  xxp0   = xyzp0(1)
 
236
  xyp0   = xyzp0(2)
 
237
  xzp0   = xyzp0(3)
 
238
  do iel = 1, ncel
 
239
    rtp(iel,ipr) = pred0
 
240
    propce(iel,iiptot) = p0                                &
 
241
         + ro0*( gx*(xyzcen(1,iel)-xxp0)                   &
 
242
         +       gy*(xyzcen(2,iel)-xyp0)                   &
 
243
         +       gz*(xyzcen(3,iel)-xzp0) )
356
244
  enddo
357
245
endif
358
246
 
407
295
 
408
296
!  -- Vitesse
409
297
 
410
 
  do iphas = 1, nphas
411
 
 
412
 
    iuiph = iu(iphas)
413
 
    iviph = iv(iphas)
414
 
    iwiph = iw(iphas)
415
 
    idimte = 1
 
298
  idimte = 1
 
299
  itenso = 0
 
300
  call percve &
 
301
  !==========
 
302
( idimte , itenso ,                                  &
 
303
  rtp(1,iu), rtp(1,iu), rtp(1,iu),                   &
 
304
  rtp(1,iv), rtp(1,iv), rtp(1,iv),                   &
 
305
  rtp(1,iw), rtp(1,iw), rtp(1,iw))
 
306
 
 
307
!  -- Tenseur de Reynolds
 
308
 
 
309
  if(itytur.eq.3) then
 
310
    idimte = 2
416
311
    itenso = 0
417
 
    call percve                                                   &
 
312
    call percve &
418
313
    !==========
419
 
    ( idimte , itenso ,                                           &
420
 
      rtp(1,iuiph), rtp(1,iuiph), rtp(1,iuiph),                   &
421
 
      rtp(1,iviph), rtp(1,iviph), rtp(1,iviph),                   &
422
 
      rtp(1,iwiph), rtp(1,iwiph), rtp(1,iwiph))
423
 
 
424
 
  enddo
425
 
 
426
 
!  -- Tenseur de Reynolds
427
 
 
428
 
  do iphas = 1, nphas
429
 
 
430
 
    if(itytur(iphas).eq.3) then
431
 
      idimte = 2
432
 
      itenso = 0
433
 
      ir11ip = ir11(iphas)
434
 
      ir22ip = ir22(iphas)
435
 
      ir33ip = ir33(iphas)
436
 
      ir12ip = ir12(iphas)
437
 
      ir13ip = ir13(iphas)
438
 
      ir23ip = ir23(iphas)
439
 
      call percve                                                 &
440
 
      !==========
441
 
    ( idimte , itenso ,                                           &
442
 
      rtp(1,ir11ip), rtp(1,ir12ip), rtp(1,ir13ip),                &
443
 
      rtp(1,ir12ip), rtp(1,ir22ip), rtp(1,ir23ip),                &
444
 
      rtp(1,ir13ip), rtp(1,ir23ip), rtp(1,ir33ip) )
445
 
    endif
 
314
  ( idimte , itenso ,                                     &
 
315
    rtp(1,ir11), rtp(1,ir12), rtp(1,ir13),                &
 
316
    rtp(1,ir12), rtp(1,ir22), rtp(1,ir23),                &
 
317
    rtp(1,ir13), rtp(1,ir23), rtp(1,ir33) )
 
318
  endif
446
319
 
447
320
!  -- Remarque pour le v2f
448
321
!     v2 (donc phi) est lie a une orientation locale, on peut donc le traiter
449
322
!     comme un scalaire dans la periodicite de rotation
450
323
 
451
324
 
452
 
  enddo
453
 
 
454
325
!  -- Variables scalaires
455
326
 
456
327
  do ivar = 1, nvar
457
 
    do iphas = 1, nphas
458
 
      if(ivar.ne.iu(iphas).and.ivar.ne.iv(iphas).and.             &
459
 
                               ivar.ne.iw(iphas).and.             &
460
 
         (itytur(iphas).ne.3.or.                                  &
461
 
          (ivar.ne.ir11(iphas).and.ivar.ne.ir22(iphas).and.       &
462
 
           ivar.ne.ir33(iphas).and.ivar.ne.ir12(iphas).and.       &
463
 
           ivar.ne.ir13(iphas).and.ivar.ne.ir23(iphas)))) then
464
 
 
465
 
        idimte = 0
466
 
        itenso = 0
467
 
        call percve                                               &
468
 
        !==========
469
 
      ( idimte , itenso ,                                         &
470
 
        rtp(1,ivar), rtp(1,ivar), rtp(1,ivar),                    &
471
 
        rtp(1,ivar), rtp(1,ivar), rtp(1,ivar),                    &
472
 
        rtp(1,ivar), rtp(1,ivar), rtp(1,ivar) )
473
 
 
474
 
      endif
475
 
    enddo
 
328
    if(ivar.ne.iu.and.ivar.ne.iv.and.ivar.ne.iw.and.       &
 
329
         (itytur.ne.3.or.                                  &
 
330
         (ivar.ne.ir11.and.ivar.ne.ir22.and.       &
 
331
         ivar.ne.ir33.and.ivar.ne.ir12.and.       &
 
332
         ivar.ne.ir13.and.ivar.ne.ir23))) then
 
333
 
 
334
      idimte = 0
 
335
      itenso = 0
 
336
      call percve                                               &
 
337
      !==========
 
338
    ( idimte , itenso ,                                         &
 
339
      rtp(1,ivar), rtp(1,ivar), rtp(1,ivar),                    &
 
340
      rtp(1,ivar), rtp(1,ivar), rtp(1,ivar),                    &
 
341
      rtp(1,ivar), rtp(1,ivar), rtp(1,ivar) )
 
342
 
 
343
    endif
476
344
  enddo
477
345
 
478
346
endif
481
349
! 4.  POUR IPHYDR ON DOIT COMMUNIQUER FRCXT AU PREMIER PASSAGE
482
350
!     (FRCXT SERT DANS TYPECL)
483
351
!     SI ICALHY=1, ON COMMUNIQUE AUSSI RHO POUR REMPLIR
484
 
!     PROPCE(1,IPPROC(IROMA(IPHAS)))
 
352
!     PROPCE(1,IPPROC(IROMA))
485
353
!===============================================================================
486
354
 
487
355
if(ipass.eq.1) then
489
357
! --- Communication de FRCXT
490
358
  if (iphydr.eq.1) then
491
359
 
492
 
    do iphas = 1, nphas
493
 
      if(irangp.ge.0) then
494
 
        call parcve (frcxt(1,1,iphas))
495
 
        !==========
496
 
        call parcve (frcxt(1,2,iphas))
497
 
        !==========
498
 
        call parcve (frcxt(1,3,iphas))
499
 
        !==========
500
 
      endif
501
 
      if(iperio.eq.1) then
502
 
        idimte = 1
503
 
        itenso = 0
504
 
        call percve                                               &
505
 
        !==========
 
360
    if(irangp.ge.0) then
 
361
      call parcve (frcxt(1,1))
 
362
      !==========
 
363
      call parcve (frcxt(1,2))
 
364
      !==========
 
365
      call parcve (frcxt(1,3))
 
366
      !==========
 
367
    endif
 
368
    if(iperio.eq.1) then
 
369
      idimte = 1
 
370
      itenso = 0
 
371
      call percve                                               &
 
372
      !==========
506
373
    ( idimte , itenso ,                                           &
507
 
      frcxt(1,1,iphas),frcxt(1,1,iphas),frcxt(1,1,iphas),         &
508
 
      frcxt(1,2,iphas),frcxt(1,2,iphas),frcxt(1,2,iphas),         &
509
 
      frcxt(1,3,iphas),frcxt(1,3,iphas),frcxt(1,3,iphas) )
510
 
      endif
511
 
 
512
 
    enddo
 
374
      frcxt(1,1),frcxt(1,1),frcxt(1,1),         &
 
375
      frcxt(1,2),frcxt(1,2),frcxt(1,2),         &
 
376
      frcxt(1,3),frcxt(1,3),frcxt(1,3) )
 
377
    endif
513
378
 
514
379
  endif
515
380
 
516
381
! --- Communication de RHO
517
382
  if (icalhy.eq.1) then
518
383
 
519
 
    do iphas = 1, nphas
520
 
      ipcrom = ipproc(irom  (iphas))
521
 
      if(irangp.ge.0) then
522
 
        call parcve (propce(1,ipcrom))
523
 
        !==========
524
 
      endif
525
 
      if(iperio.eq.1) then
526
 
        idimte = 0
527
 
        itenso = 0
528
 
        call percve                                               &
529
 
        !==========
 
384
    ipcrom = ipproc(irom  )
 
385
    if(irangp.ge.0) then
 
386
      call parcve (propce(1,ipcrom))
 
387
      !==========
 
388
    endif
 
389
    if(iperio.eq.1) then
 
390
      idimte = 0
 
391
      itenso = 0
 
392
      call percve                                               &
 
393
      !==========
530
394
    ( idimte , itenso ,                                           &
531
395
      propce(1,ipcrom),propce(1,ipcrom),propce(1,ipcrom),         &
532
396
      propce(1,ipcrom),propce(1,ipcrom),propce(1,ipcrom),         &
533
397
      propce(1,ipcrom),propce(1,ipcrom),propce(1,ipcrom) )
534
 
      endif
535
 
    enddo
 
398
    endif
536
399
 
537
400
  endif
538
401
 
553
416
enddo
554
417
 
555
418
if (icalhy.eq.1) then
556
 
  do iphas = 1, nphas
557
 
    ipcrom = ipproc(irom  (iphas))
558
 
    ipcroa = ipproc(iroma (iphas))
559
 
    do iel = 1, ncelet
560
 
      propce(iel,ipcroa) = propce(iel,ipcrom)
561
 
    enddo
 
419
  ipcrom = ipproc(irom  )
 
420
  ipcroa = ipproc(iroma )
 
421
  do iel = 1, ncelet
 
422
    propce(iel,ipcroa) = propce(iel,ipcrom)
562
423
  enddo
563
424
endif
564
425
 
582
443
  iappel = 1
583
444
  call schtmp                                                     &
584
445
  !==========
585
 
 ( idebia , idebra ,                                              &
586
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
587
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
588
 
   nvar   , nscal  , nphas  , iappel ,                            &
589
 
   nideve , nrdeve , nituse , nrtuse ,                            &
590
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
591
 
   ipnfac , nodfac , ipnfbr , nodfbr , isostd ,                   &
592
 
   idevel , ituser , ia     ,                                     &
593
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
446
 ( nvar   , nscal  , iappel ,                                     &
 
447
   isostd ,                                                       &
594
448
   dt     , rtpa   , rtp    , propce , propfa , propfb ,          &
595
 
   coefa  , coefb  ,                                              &
596
 
   rdevel , rtuser ,                                              &
597
 
   ra     )
 
449
   coefa  , coefb  )
598
450
endif
599
451
 
600
452
 
624
476
    do ii = 1, 3
625
477
      xyznod(ii,inod) = 0.d0
626
478
      do jj = 1, 3
627
 
        xyznod(ii,inod) = xyznod(ii,inod) &
628
 
                        + rrotgb(ii,jj)*ra(ixyzn0+(inod-1)*ndim+jj-1)
629
 
 
 
479
        xyznod(ii,inod) = xyznod(ii,inod) + rrotgb(ii,jj)*xyzno0(jj,inod)
630
480
      enddo
631
481
    enddo
632
482
  enddo
633
483
 
634
484
  call algrma
635
485
  !==========
636
 
  call calgeo &
637
 
  !==========
638
 
 ( idebia , idebra ,                                              &
639
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
640
 
   nnod   , lndfac , lndfbr ,                                     &
641
 
   nideve , nrdeve , nituse , nrtuse ,                            &
642
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
643
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
644
 
   idevel , ituser , ia     ,                                     &
645
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
646
 
   volmin , volmax , voltot ,                                     &
647
 
   rdevel , rtuser , ra     )
 
486
 
 
487
  ! Abort at the end of the current time-step if there is a negative volume
 
488
  if (volmin.le.0.d0) ntmabs = ntcabs
648
489
 
649
490
endif
650
491
 
670
511
!        (VISCOSITES ET MASSE VOLUMIQUE)
671
512
!===============================================================================
672
513
 
673
 
if(iwarni(iu(1)).ge.1) then
 
514
if(iwarni(iu).ge.1) then
674
515
  write(nfecra,1010)
675
516
endif
676
517
 
677
 
call memphy                                                       &
678
 
!==========
679
 
 ( idebia , idebra ,                                              &
680
 
   nvar   , ncelet , ncel   , nfac   , nfabor , nphas  ,          &
681
 
   iw1    , iw2    , iw3    , iw4    ,                            &
682
 
   iw5    , iw6    , iw7    , iw8    ,                            &
683
 
   iw9    , iw10   , iw11   , iw12   , ixmij  ,                   &
684
 
   ifinia , ifinra )
685
 
 
686
518
call phyvar                                                       &
687
519
!==========
688
 
 ( ifinia , ifinra ,                                              &
689
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
690
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
691
 
   nvar   , nscal  , nphas  ,                                     &
692
 
   nideve , nrdeve , nituse , nrtuse ,                            &
693
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
694
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
695
 
   idevel , ituser , ia     ,                                     &
696
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
520
 ( nvar   , nscal  ,                                              &
697
521
   dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
698
 
   coefa  , coefb  ,                                              &
699
 
   ra(iw1), ra(iw2), ra(iw3), ra(iw4), ra(iw5), ra(iw6),          &
700
 
   ra(iw7), ra(iw8), ra(iw9), ra(iw10), ra(iw11), ra(iw12),       &
701
 
   ra(ixmij) ,                                                    &
702
 
   rdevel , rtuser , ra     )
 
522
   coefa  , coefb  )
703
523
 
704
524
if (itrale.gt.0) then
705
525
  iappel = 2
706
526
  call schtmp                                                     &
707
527
!==========
708
 
 ( idebia , idebra ,                                              &
709
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
710
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
711
 
   nvar   , nscal  , nphas  , iappel ,                            &
712
 
   nideve , nrdeve , nituse , nrtuse ,                            &
713
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
714
 
   ipnfac , nodfac , ipnfbr , nodfbr , isostd ,                   &
715
 
   idevel , ituser , ia     ,                                     &
716
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
528
 ( nvar   , nscal  , iappel ,                                     &
 
529
   isostd ,                                                       &
717
530
   dt     , rtpa   , rtp    , propce , propfa , propfb ,          &
718
 
   coefa  , coefb  ,                                              &
719
 
   rdevel , rtuser ,                                              &
720
 
   ra     )
 
531
   coefa  , coefb  )
721
532
endif
722
533
 
723
534
 
727
538
!    LA VITESSE MOYENNE OU MAX.
728
539
 
729
540
 
730
 
do iphas = 1, nphas
731
 
 
732
 
  if (ncpdct(iphas).gt.0) then
733
 
 
734
 
    iappel = 3
735
 
    if (imatis.eq.1) then
736
 
 
737
 
      call mtkpdc                                                 &
738
 
      !==========
739
 
 ( idebia , idebra ,                                              &
740
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
741
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
742
 
   nvar   , nscal  , nphas  ,                                     &
743
 
   nideve , nrdeve , nituse , nrtuse ,                            &
744
 
   ncepdc(iphas) , iphas  , iappel ,                              &
745
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
746
 
   ipnfac , nodfac , ipnfbr , nodfbr , ia(iicepd(iphas)) ,        &
747
 
   idevel , ituser , ia     ,                                     &
748
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
749
 
   dt     , rtpa   , rtp    , propce , propfa , propfb ,          &
750
 
   coefa  , coefb  , ra(ickupd(iphas)) ,                          &
751
 
   rdevel , rtuser , ra     )
752
 
 
753
 
    else
754
 
 
755
 
      if (iihmpr.eq.1) then
756
 
        call uikpdc &
757
 
        !==========
758
 
      ( iappel, iphas, ncelet, ncepdc,             &
759
 
        ia(iicepd(iphas)), ra(ickupd(iphas)), rtpa )
760
 
      endif
761
 
 
762
 
      ils    = idebia
763
 
      idbia1 = ils + maxelt
764
 
      CALL IASIZE('TRIDIM',IDBIA1)
765
 
 
766
 
      call uskpdc                                                 &
767
 
      !==========
768
 
 ( idbia1 , idebra ,                                              &
769
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
770
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
771
 
   nvar   , nscal  , nphas  ,                                     &
772
 
   nideve , nrdeve , nituse , nrtuse ,                            &
773
 
   ncepdc(iphas) , iphas  , iappel ,                              &
774
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml , maxelt , ia(ils), &
775
 
   ipnfac , nodfac , ipnfbr , nodfbr , ia(iicepd(iphas)) ,        &
776
 
   idevel , ituser , ia     ,                                     &
777
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
778
 
   dt     , rtpa   , rtp    , propce , propfa , propfb ,          &
779
 
   coefa  , coefb  , ra(ickupd(iphas)) ,                          &
780
 
   rdevel , rtuser , ra     )
781
 
 
782
 
    endif
783
 
 
 
541
if (ncpdct.gt.0) then
 
542
 
 
543
  iappel = 3
 
544
 
 
545
  if (iihmpr.eq.1) then
 
546
    call uikpdc &
 
547
    !==========
 
548
  ( iappel, ncelet, ncepdc,             &
 
549
    icepdc, ckupdc, rtpa )
784
550
  endif
785
551
 
786
 
enddo
 
552
  call uskpdc &
 
553
  !==========
 
554
( nvar   , nscal  ,                                              &
 
555
  ncepdc , iappel ,                                              &
 
556
  icepdc , izcpdc ,                                              &
 
557
  dt     , rtpa   , rtp    , propce , propfa , propfb ,          &
 
558
  coefa  , coefb  , ckupdc )
 
559
 
 
560
endif
787
561
 
788
562
 
789
563
! REMPLISSAGE DES COEFS DE TERME SOURCE DE MASSE
790
564
 
791
 
do iphas = 1, nphas
792
 
 
793
565
!    ON Y PASSE MEME S'IL N'Y A PAS DE TSM SUR LE PROC COURANT AU CAS OU
794
566
!    UN UTILISATEUR DECIDERAIT D'AVOIR UN TSM DEPENDANT DE
795
567
!    VALEURS GLOBALES OU MAX.
796
 
  if(nctsmt(iphas).gt.0) then
797
 
 
798
 
    ils    = idebia
799
 
    idbia1 = ils + maxelt
800
 
    CALL IASIZE('TRIDIM',IDBIA1)
801
 
 
802
 
!     Mise a zero du tableau de type de TS masse et source
803
 
    do ii = 1, ncetsm(iphas)*nvar
804
 
      ia(iitpsm(iphas)+ii-1) = 0
805
 
      ra(ismace(iphas)+ii-1) = 0.d0
 
568
if(nctsmt.gt.0) then
 
569
 
 
570
  !     Mise a zero du tableau de type de TS masse et source
 
571
  do ii = 1, ncetsm
 
572
    do ivar = 1, nvar
 
573
      itypsm(ii,ivar) = 0
 
574
      smacel(ii,ivar) = 0.d0
806
575
    enddo
807
 
 
808
 
    iappel = 3
809
 
    call  ustsma                                                  &
810
 
!         ============
811
 
 ( idbia1 , idebra ,                                              &
812
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
813
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
814
 
   nvar   , nscal  , nphas  , ncepdc(iphas)   ,                   &
815
 
   nideve , nrdeve , nituse , nrtuse ,                            &
816
 
   ncetsm(iphas)   , iphas  , iappel ,                            &
817
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml , maxelt , ia(ils), &
818
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
819
 
   ia(iicepd(iphas)) ,                                            &
820
 
   ia(iicesm(iphas)) , ia(iitpsm(iphas)) ,                        &
821
 
   idevel , ituser , ia     ,                                     &
822
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
823
 
   dt     , rtpa   , propce , propfa , propfb ,                   &
824
 
   coefa  , coefb  , ra(ickupd(iphas)), ra(ismace(iphas)),        &
825
 
   rdevel , rtuser , ra     )
826
 
 
827
 
  endif
828
 
 
829
 
enddo
 
576
  enddo
 
577
 
 
578
  iappel = 3
 
579
  call  ustsma &
 
580
  !===========
 
581
( nvar   , nscal  , ncepdc ,                                     &
 
582
  ncetsm , iappel ,                                              &
 
583
  icepdc ,                                                       &
 
584
  icetsm , itypsm , izctsm ,                                     &
 
585
  dt     , rtpa   , propce , propfa , propfb ,                   &
 
586
  coefa  , coefb  , ckupdc , smacel )
 
587
 
 
588
endif
830
589
 
831
590
!===============================================================================
832
591
! 8.  CALCUL DU NOMBRE DE COURANT ET DE FOURIER
833
592
!     CALCUL DU PAS DE TEMPS SI VARIABLE
834
593
!===============================================================================
835
594
 
836
 
if(iwarni(iu(1)).ge.1) then
 
595
if(iwarni(iu).ge.1) then
837
596
  write(nfecra,1020)
838
597
endif
839
598
 
840
 
call memdtv                                                       &
841
 
!==========
842
 
 ( idebia , idebra ,                                              &
843
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
844
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
845
 
   nvar   , nscal  , nphas  ,                                     &
846
 
   iviscf , iviscb , idam   , icofbd , iw1    , iw2    , iw3    , &
847
 
   icofbr , igrarx , igrary , igrarz , iwcf   ,                   &
848
 
   iptlro , ippmod(icompf) ,                                      &
849
 
   ifinia , ifinra )
850
 
 
851
 
iphas = 1
852
 
 
853
 
call dttvar                                                       &
854
 
!==========
855
 
 ( ifinia , ifinra ,                                              &
856
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
857
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
858
 
   nvar   , nscal  , nphas  ,                                     &
859
 
   ncepdc(iphas)   , ncetsm(iphas)   ,                            &
860
 
   nideve , nrdeve , nituse , nrtuse , iwarni(iu(1))   ,          &
861
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
862
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
863
 
   ia(iicepd(iphas)), ia(iicesm(iphas)), ia(iitpsm(iphas)) ,      &
864
 
   idevel , ituser , ia     ,                                     &
865
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
599
call dttvar &
 
600
!==========
 
601
 ( nvar   , nscal  ,                                              &
 
602
   ncepdc , ncetsm ,                                              &
 
603
   iwarni(iu)   ,                                                 &
 
604
   icepdc , icetsm , itypsm ,                                     &
866
605
   dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
867
 
   coefa  , coefb  , ra(ickupd(iphas)) , ra(ismace(iphas)),       &
868
 
   ra(iviscf)      , ra(iviscb)      , ra(idam)      ,            &
869
 
   ra(icofbd)      , ra(iw1)         , ra(iw2)       , ra(iw3)   ,&
870
 
   ra(icofbr)      , ra(igrarx)      , ra(igrary)    , ra(igrarz),&
871
 
   ra(iwcf),                                                      &
872
 
   rdevel , rtuser , ra     )
 
606
   coefa  , coefb  , ckupdc , smacel )
873
607
 
874
608
if (nbaste.gt.0.and.itrale.gt.nalinf) then
875
609
  ntrela = ntcabs - ntpabs
880
614
! 9.  CHARGEMENT ET TRADUCTION DES CONDITIONS AUX LIMITES
881
615
!===============================================================================
882
616
 
883
 
if(iwarni(iu(1)).ge.1) then
 
617
if(iwarni(iu).ge.1) then
884
618
  write(nfecra,1030)
885
619
endif
886
620
 
890
624
 
891
625
if (ivrtex.eq.1) then
892
626
 
893
 
  ils    = ifinia
894
 
  ifnia1 = ils + maxelt
895
 
  CALL IASIZE('TRIDIM',IFNIA1)
896
 
 
897
 
  iphas  = 1
898
627
  iappel = 2
899
628
  call usvort &
900
629
  !==========
901
 
 ( ifnia1 , ifinra ,                                              &
902
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
903
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
904
 
   nvar   , nscal  , nphas  ,                                     &
905
 
   nideve , nrdeve , nituse , nrtuse ,                            &
906
 
   iphas  , iappel ,                                              &
907
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml, maxelt , ia(ils),  &
908
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
909
 
   ia(iirepv)      ,                                              &
910
 
   idevel , ituser , ia     ,                                     &
911
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo ,                   &
912
 
   xyznod , volume ,                                              &
 
630
 ( nvar   , nscal  ,                                              &
 
631
   iappel ,                                                       &
913
632
   dt     , rtpa   ,                                              &
914
633
   propce , propfa , propfb ,                                     &
915
 
   coefa  , coefb  ,                                              &
916
 
   rdevel , rtuser , ra     )
 
634
   coefa  , coefb  )
917
635
 
918
636
!     Verification des donnees entrees par l'utilisateur
919
637
!       (au premier passage seulement)
920
638
  if (ipass.eq.1) then
921
 
    call vorver ( nfabor , ia(iirepv)  , iappel )
 
639
    call vorver ( nfabor , iappel )
922
640
    !==========
923
641
  endif
924
642
 
925
643
  if(irangp.le.0) then
926
 
    call vortex &
 
644
    call vortex
927
645
    !==========
928
 
 ( ia(iivrce) , ra(ivisv)  , ra(ixyzv) ,                          &
929
 
   ra(iyzcel) , ra(iuvort) , ra(ivvort),                          &
930
 
   ra(iwvort) ,                                                   &
931
 
   ra(iyzvor) , ra(iyzvoa) , ra(isignv),                          &
932
 
   ra(ixsigm) , ra(ixgamm) , ra(ixtmp) ,                          &
933
 
   ra(ixtmpl) )
934
646
  endif
935
647
 
936
648
! -- Fin de zone Methode des vortex
943
655
!       pour Syrthes, T1D ou rayonnement.
944
656
italim = 1
945
657
itrfin = 1
946
 
idbia1 = idebia
947
 
idbra1 = idebra
948
 
iflalf = 1
949
 
iflalb = 1
950
 
icoale = 1
951
 
iprale = 1
952
658
ineefl = 0
953
659
if (iale.eq.1 .and. nalimx.gt.1 .and. itrale.gt.nalinf) then
954
660
!     On reserve certains tableaux pour permettre le retour a l'etat
962
668
!         necessaire ...
963
669
!       Pas la peine de tester les depassements car on passe dans
964
670
!       memcli juste apres.
965
 
  iflalf = idebra
966
 
  iflalb = iflalf + nfac
967
 
  icoale = iflalb + nfabor
968
 
  iprale = icoale + 8*nfabor
969
 
  idbra1 = iprale + ncelet
 
671
  allocate(flmalf(nfac))
 
672
  allocate(flmalb(nfabor))
 
673
  allocate(cofale(nfabor,8))
 
674
  allocate(xprale(ncelet))
970
675
  ineefl = 1
971
676
 
972
677
  if (nbccou.gt.0 .or. nfpt1t.gt.0 .or. iirayo.gt.0) itrfin = 0
982
687
!     pour Syrthes, T1D ou rayonnement.
983
688
itrfup = 1
984
689
 
985
 
iximpa = 1
986
 
iuvwk  = 1
987
 
itrava = 1
988
690
if (nterup.gt.1) then
989
 
  iximpa = idbra1
990
 
  iuvwk  = iximpa + ncelet*ndim*nphas
991
 
  itrava = iuvwk  + ncelet*ndim*nphas
992
 
  idbra1 = itrava + ncelet*ndim*nphas
 
691
 
 
692
  if (ivelco.eq.1) then
 
693
    allocate(ximpav(ndim,ndim,ncelet))
 
694
    allocate(uvwk(ndim,ncelet))
 
695
    allocate(trava(ndim,ncelet))
 
696
  else
 
697
    allocate(ximpa(ncelet,ndim))
 
698
    allocate(uvwk(ncelet,ndim))
 
699
    allocate(trava(ncelet,ndim))
 
700
  endif
993
701
 
994
702
  if (nbccou.gt.0 .or. nfpt1t.gt.0 .or. iirayo.gt.0) itrfup = 0
995
703
 
1001
709
iterns = 1
1002
710
do while (iterns.le.nterup)
1003
711
 
1004
 
 
1005
 
  call memcli &
1006
 
  !==========
1007
 
( idbia1 , idbra1 ,                                              &
1008
 
  ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1009
 
  nnod   , lndfac , lndfbr , ncelbr ,                            &
1010
 
  nvar   , nscal  , nphas  ,                                     &
1011
 
  isvhb  , isvtb  ,                                              &
1012
 
  iicodc , ircodc ,                                              &
1013
 
  iw1    , iw2    , iw3    , iw4    , iw5    , iw6    ,          &
1014
 
  icoefu , irijip , iuetbo , ivsvdr , ihbord , itbord ,          &
1015
 
  ifinia , ifinra )
 
712
  ! Allocate temporary arrays for boundary conditions
 
713
  allocate(icodcl(nfabor,nvar))
 
714
  allocate(rcodcl(nfabor,nvar,3))
 
715
  if (isvhb.gt.0) then
 
716
    allocate(hbord(nfabor))
 
717
  endif
 
718
  if (isvtb.gt.0 .or. iirayo.gt.0) then
 
719
    allocate(tbord(nfabor))
 
720
  endif
 
721
  if (itytur.eq.4 .and. idries.eq.1) then
 
722
    allocate(visvdr(ncelet))
 
723
  endif
1016
724
 
1017
725
  call precli &
1018
726
  !==========
1019
 
( ifinia , ifinra ,                                              &
1020
 
  ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1021
 
  nnod   , lndfac , lndfbr , ncelbr ,                            &
1022
 
  nvar   , nscal  , nphas  ,                                     &
1023
 
  nideve , nrdeve , nituse , nrtuse ,                            &
1024
 
  ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
1025
 
  ipnfac , nodfac , ipnfbr , nodfbr ,                            &
1026
 
  ia(iicodc)      , ia(iizfpp)      ,                            &
1027
 
  idevel , ituser , ia     ,                                     &
1028
 
  xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
727
( nvar   , nscal  ,                                              &
 
728
  icodcl ,                                                       &
1029
729
  dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
1030
730
  coefa  , coefb  ,                                              &
1031
 
  ra(ircodc) , ra(icoefu) ,                                      &
1032
 
  ra(iw1   ) , ra(iw2   ) , ra(iw3   ) ,                         &
1033
 
  ra(iw4   ) , ra(iw5   ) , ra(iw6   ) ,                         &
1034
 
  rdevel , rtuser , ra     )
1035
 
 
1036
 
 
1037
 
  if (imatis.eq.0) then
1038
 
 
1039
 
  ! ON NE FAIT PAS DE MATISSE
 
731
  rcodcl )
 
732
 
1040
733
 
1041
734
  !     - Interface Code_Saturne
1042
735
  !       ======================
1043
736
 
1044
 
    if (iihmpr.eq.1) then
1045
 
 
1046
 
    ! N.B. Zones de face de bord : on utilise provisoirement les zones des
1047
 
    !    physiques particulieres, meme sans physique particuliere
1048
 
    !    -> sera modifie lors de la restructuration des zones de bord
1049
 
 
1050
 
      call uiclim &
1051
 
      !==========
1052
 
    ( ntcabs, nfabor,                                                &
1053
 
      nozppm, ncharm, ncharb, nclpch,                                &
1054
 
      iindef, ientre, iparoi, iparug, isymet, isolib,                &
1055
 
      iqimp,  icalke, ientat, ientcp, inmoxy, iprofm,                &
1056
 
      ia(iitypf), ia(iizfpp), ia(iicodc),                            &
1057
 
      dtref,  ttcabs, surfbo, cdgfbo,                                &
1058
 
      qimp,   qimpat, qimpcp, dh,     xintur,                        &
1059
 
      timpat, timpcp, distch, ra(ircodc) )
1060
 
 
1061
 
      if (ippmod(iphpar).eq.0) then
1062
 
 
1063
 
      ! ON NE FAIT PAS DE LA PHYSIQUE PARTICULIERE NI DE MATISSE
1064
 
 
1065
 
        nbzfmx = nbzppm
1066
 
        nozfmx = nozppm
1067
 
        iilzfb = ifinia
1068
 
        ifnia1 = iilzfb + nbzfmx
1069
 
        iqcalc = ifinra
1070
 
        ifnra1 = iqcalc + nozfmx
1071
 
        CALL IASIZE('TRIDIM',IFNIA1)
1072
 
        CALL RASIZE('TRIDIM',IFNRA1)
1073
 
 
1074
 
        call stdtcl &
1075
 
        !==========
1076
 
      ( ifnia1 , ifnra1 ,                                              &
1077
 
        ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1078
 
        nnod   , lndfac , lndfbr , ncelbr ,                            &
1079
 
        nvar   , nscal  , nphas  , nbzfmx , nozfmx ,                   &
1080
 
        nideve , nrdeve , nituse , nrtuse ,                            &
1081
 
        ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
1082
 
        ipnfac , nodfac , ipnfbr , nodfbr ,                            &
1083
 
        iqimp  , icalke , qimp   , dh , xintur,                        &
1084
 
        ia(iicodc)      , ia(iitrif)   , ia(iitypf)   , ia(iizfpp)   , &
1085
 
        ia(iilzfb)      , idevel , ituser , ia     ,                   &
1086
 
        xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
1087
 
        dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
1088
 
        coefa  , coefb  , ra(ircodc)      ,                            &
1089
 
        ra(iw1), ra(iw2), ra(iw3), ra(iw4), ra(iw5), ra(iw6),          &
1090
 
        ra(icoefu)      , ra(iqcalc)      ,                            &
1091
 
        rdevel , rtuser , ra     )
1092
 
 
1093
 
      endif
1094
 
 
1095
 
    endif
1096
 
 
1097
 
    !     - Sous-programme utilisateur
1098
 
    !       ==========================
 
737
  if (iihmpr.eq.1) then
 
738
 
 
739
  ! N.B. Zones de face de bord : on utilise provisoirement les zones des
 
740
  !    physiques particulieres, meme sans physique particuliere
 
741
  !    -> sera modifie lors de la restructuration des zones de bord
 
742
 
 
743
    call uiclim &
 
744
    !==========
 
745
  ( ntcabs, nfabor,                                                &
 
746
    nozppm, ncharm, ncharb, nclpch,                                &
 
747
    iindef, ientre, iparoi, iparug, isymet, isolib,                &
 
748
    iqimp,  icalke, ientat, ientcp, inmoxy, iprofm,                &
 
749
    itypfb, izfppp, icodcl,                                    &
 
750
    dtref,  ttcabs, surfbo, cdgfbo,                                &
 
751
    qimp,   qimpat, qimpcp, dh,     xintur,                        &
 
752
    timpat, timpcp, distch, rcodcl)
1099
753
 
1100
754
    if (ippmod(iphpar).eq.0) then
1101
755
 
1102
 
      ils    = ifinia
1103
 
      ifnia1 = ils + maxelt
1104
 
      CALL IASIZE('TRIDIM',IFNIA1)
1105
 
 
1106
 
      call usclim &
1107
 
      !==========
1108
 
    ( ifnia1 , ifinra ,                                              &
1109
 
      ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1110
 
      nnod   , lndfac , lndfbr , ncelbr ,                            &
1111
 
      nvar   , nscal  , nphas  ,                                     &
1112
 
      nideve , nrdeve , nituse , nrtuse ,                            &
1113
 
      ifacel , ifabor , ifmfbr , ifmcel , iprfml , maxelt , ia(ils), &
1114
 
      ipnfac , nodfac , ipnfbr , nodfbr ,                            &
1115
 
      ia(iicodc)      , ia(iitrif)   , ia(iitypf)   ,                &
1116
 
      idevel , ituser , ia     ,                                     &
1117
 
      xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
1118
 
      dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
1119
 
      coefa  , coefb  , ra(ircodc)      ,                            &
1120
 
      ra(iw1), ra(iw2), ra(iw3), ra(iw4), ra(iw5), ra(iw6),          &
1121
 
      ra(icoefu)      ,                                              &
1122
 
      rdevel , rtuser , ra     )
1123
 
 
1124
 
    else
1125
 
 
1126
 
      ! ON FAIT DE LA PHYSIQUE PARTICULIERE (MAIS PAS DE MATISSE)
1127
 
 
1128
 
      call ppclim &
1129
 
      !==========
1130
 
    ( ifinia , ifinra ,                                              &
1131
 
      ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1132
 
      nnod   , lndfac , lndfbr , ncelbr ,                            &
1133
 
      nvar   , nscal  , nphas  ,                                     &
1134
 
      nideve , nrdeve , nituse , nrtuse ,                            &
1135
 
      ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
1136
 
      ipnfac , nodfac , ipnfbr , nodfbr ,                            &
1137
 
      ia(iicodc)      , ia(iitrif)   , ia(iitypf)   , ia(iizfpp) ,   &
1138
 
      idevel , ituser , ia     ,                                     &
1139
 
      xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
1140
 
      dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
1141
 
      coefa  , coefb  , ra(ircodc)      ,                            &
1142
 
      ra(iw1), ra(iw2), ra(iw3), ra(iw4), ra(iw5), ra(iw6),          &
1143
 
      ra(icoefu)      ,                                              &
1144
 
      rdevel , rtuser , ra     )
1145
 
 
1146
 
    endif
1147
 
 
1148
 
    !     - Interface Code_Saturne
1149
 
    !       ======================
1150
 
 
1151
 
    if(iihmpr.eq.1) then
1152
 
 
1153
 
      call uiclve &
1154
 
      !==========
1155
 
    ( nfabor, nozppm,                                                &
1156
 
      iindef, ientre, iparoi, iparug, isymet, isolib,                &
1157
 
      ia(iitypf), ia(iizfpp) )
1158
 
 
1159
 
    endif
 
756
    ! ON NE FAIT PAS DE LA PHYSIQUE PARTICULIERE
 
757
 
 
758
      nbzfmx = nbzppm
 
759
      nozfmx = nozppm
 
760
      allocate(ilzfbr(nbzfmx))
 
761
      allocate(qcalc(nozfmx))
 
762
 
 
763
      call stdtcl &
 
764
      !==========
 
765
    ( nvar   , nscal  , nbzfmx , nozfmx ,                            &
 
766
      iqimp  , icalke , qimp   , dh , xintur,                        &
 
767
      icodcl , itrifb , itypfb , izfppp ,                            &
 
768
      ilzfbr ,                                                       &
 
769
      dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
 
770
      coefa  , coefb  , rcodcl ,                                     &
 
771
      qcalc  )
 
772
 
 
773
      ! Free memory
 
774
      deallocate(ilzfbr)
 
775
      deallocate(qcalc)
 
776
 
 
777
    endif
 
778
 
 
779
  endif
 
780
 
 
781
  !     - Sous-programme utilisateur
 
782
  !       ==========================
 
783
 
 
784
  if (ippmod(iphpar).eq.0) then
 
785
 
 
786
    call usclim &
 
787
    !==========
 
788
  ( nvar   , nscal  ,                                              &
 
789
    icodcl , itrifb , itypfb ,                                     &
 
790
    dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
 
791
    coefa  , coefb  , rcodcl )
 
792
 
 
793
  else
 
794
 
 
795
    ! ON FAIT DE LA PHYSIQUE PARTICULIERE
 
796
 
 
797
    call ppclim &
 
798
    !==========
 
799
  ( nvar   , nscal  ,                                              &
 
800
    icodcl , itrifb , itypfb , izfppp ,                            &
 
801
    dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
 
802
    coefa  , coefb  , rcodcl )
 
803
 
 
804
  endif
 
805
 
 
806
  !     - Interface Code_Saturne
 
807
  !       ======================
 
808
 
 
809
  if(iihmpr.eq.1) then
 
810
 
 
811
    call uiclve &
 
812
    !==========
 
813
  ( nfabor, nozppm,                                                &
 
814
    iindef, ientre, iparoi, iparug, isymet, isolib,                &
 
815
    itypfb, izfppp )
1160
816
 
1161
817
  endif
1162
818
 
1167
823
 
1168
824
    call vor2cl &
1169
825
    !==========
1170
 
  ( ifinia , ifinra ,                                              &
1171
 
    ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1172
 
    nnod   , lndfac , lndfbr , ncelbr ,                            &
1173
 
    nvar   , nscal  , nphas  ,                                     &
1174
 
    nideve , nrdeve , nituse , nrtuse ,                            &
1175
 
    ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
1176
 
    ipnfac , nodfac , ipnfbr , nodfbr ,                            &
1177
 
    ia(iicodc)      , ia(iitrif)      , ia(iitypf)   ,             &
1178
 
    idevel , ia(iirepv)      , ituser , ia     ,                   &
1179
 
    xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
826
  ( nvar   , nscal  ,                                              &
 
827
    icodcl , itrifb , itypfb ,                                     &
1180
828
    dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
1181
 
    coefa  , coefb  , ra(ircodc)      ,                            &
1182
 
    ra(iw1), ra(iw2), ra(iw3), ra(iw4), ra(iw5), ra(iw6),          &
1183
 
    ra(icoefu)       ,                                             &
1184
 
    rdevel , rtuser , ra     )
 
829
    coefa  , coefb  , rcodcl )
1185
830
 
1186
831
  endif
1187
832
 
1188
833
  ! --- Couplage code/code entre deux instances (ou plus) de Code_Saturne
1189
834
  !       On s'occupe ici du couplage via les faces de bord, et de la
1190
 
  !       transformation de l'information reçue en condition limite.
 
835
  !       transformation de l'information re�ue en condition limite.
1191
836
 
1192
837
  if (nbrcpl.gt.0) then
1193
838
 
1194
839
    call cscfbr &
1195
840
    !==========
1196
 
  ( ifinia , ifinra ,                                              &
1197
 
    ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1198
 
    nnod   , lndfac , lndfbr , ncelbr ,                            &
1199
 
    nvar   , nscal  , nphas  ,                                     &
1200
 
    nideve , nrdeve , nituse , nrtuse ,                            &
1201
 
    ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
1202
 
    ipnfac , nodfac , ipnfbr , nodfbr ,                            &
1203
 
    ia(iicodc)      , ia(iitrif)      , ia(iitypf)   ,             &
1204
 
    idevel , ituser , ia    ,                                      &
1205
 
    xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
841
  ( nvar   , nscal  ,                                              &
 
842
    icodcl , itrifb , itypfb ,                                     &
1206
843
    dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
1207
 
    coefa  , coefb  , ra(ircodc)      ,                            &
1208
 
    ra(iw1), ra(iw2), ra(iw3), ra(iw4), ra(iw5), ra(iw6),          &
1209
 
    ra(icoefu)      ,                                              &
1210
 
    rdevel , rtuser , ra     )
 
844
    coefa  , coefb  , rcodcl )
1211
845
 
1212
846
  endif
1213
847
 
1216
850
  if (iale.eq.1) then
1217
851
 
1218
852
    do ii = 1, nnod
1219
 
      ia(iimpal+ii-1) = 0
 
853
      impale(ii) = 0
1220
854
    enddo
1221
855
 
1222
856
    ! - Interface Code_Saturne
1228
862
      !==========
1229
863
    ( nfabor, nozppm,                    &
1230
864
      ibfixe, igliss, ivimpo,            &
1231
 
      ia(iialty), ipnfbr, nnod, nodfbr,  &
1232
 
      ia(iimpal),                        &
1233
 
      ra(idepal),                        &
 
865
      ialtyb, ipnfbr, nnod, nodfbr,      &
 
866
      impale,                            &
 
867
      depale,                            &
1234
868
      dtref, ttcabs, ntcabs,             &
1235
869
      iuma, ivma, iwma,                  &
1236
 
      ra(ircodc)  )
 
870
      rcodcl)
1237
871
 
1238
872
    endif
1239
873
 
1240
 
    ils    = ifinia
1241
 
    ifnia1 = ils + maxelt
1242
 
    CALL IASIZE('TRIDIM',IFNIA1)
1243
 
 
1244
874
    call usalcl &
1245
875
    !==========
1246
 
  ( ifnia1 , ifinra , itrale ,                                     &
1247
 
    ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1248
 
    nnod   , lndfac , lndfbr , ncelbr ,                            &
1249
 
    nvar   , nscal  , nphas  ,                                     &
1250
 
    nideve , nrdeve , nituse , nrtuse ,                            &
1251
 
    ifacel , ifabor , ifmfbr , ifmcel , iprfml , maxelt , ia(ils), &
1252
 
    ipnfac , nodfac , ipnfbr , nodfbr ,                            &
1253
 
    ia(iicodc)      , ia(iitypf)      , ia(iialty)      ,          &
1254
 
    ia(iimpal)      ,                                              &
1255
 
    idevel , ituser , ia     ,                                     &
1256
 
    xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
876
  ( itrale ,                                                       &
 
877
    nvar   , nscal  ,                                              &
 
878
    icodcl , itypfb , ialtyb ,                                     &
 
879
    impale ,                                                       &
1257
880
    dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
1258
 
    coefa  , coefb  , ra(ircodc)      ,                            &
1259
 
    ra(ixyzn0)      , ra(idepal)      ,                            &
1260
 
    rdevel , rtuser , ra     )
 
881
    coefa  , coefb  , rcodcl ,                                     &
 
882
    xyzno0 , depale )
1261
883
 
1262
884
    !     Au cas ou l'utilisateur aurait touche DEPALE sans mettre IMPALE=1, on
1263
885
    !       remet le deplacement initial
1264
886
    do ii  = 1, nnod
1265
 
      if (ia(iimpal+ii-1).eq.0) then
1266
 
        ra(idepal+ii-1       ) = xyznod(1,ii)-ra(ixyzn0+(ii-1)*ndim  )
1267
 
        ra(idepal+ii-1+  nnod) = xyznod(2,ii)-ra(ixyzn0+(ii-1)*ndim+1)
1268
 
        ra(idepal+ii-1+2*nnod) = xyznod(3,ii)-ra(ixyzn0+(ii-1)*ndim+2)
 
887
      if (impale(ii).eq.0) then
 
888
        depale(ii,1) = xyznod(1,ii)-xyzno0(1,ii)
 
889
        depale(ii,2) = xyznod(2,ii)-xyzno0(2,ii)
 
890
        depale(ii,3) = xyznod(3,ii)-xyzno0(3,ii)
1269
891
      endif
1270
892
    enddo
1271
893
 
1274
896
 
1275
897
      call strpre &
1276
898
      !==========
1277
 
    ( ifinia , ifinra , itrale , italim , ineefl ,                   &
1278
 
      ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1279
 
      nnod   , lndfac , lndfbr , ncelbr ,                            &
1280
 
      nideve , nrdeve , nituse , nrtuse ,                            &
1281
 
      ifacel , ifabor , ifmfbr , ifmcel , iprfml,                    &
1282
 
      ipnfac , nodfac , ipnfbr , nodfbr ,                            &
1283
 
      ia(iimpal)      ,                                              &
1284
 
      idevel , ituser , ia     ,                                     &
1285
 
      xyzcen , surfac , surfbo , cdgfac , cdgfbo ,                   &
1286
 
      xyznod , volume ,                                              &
 
899
    ( itrale , italim , ineefl ,                                     &
 
900
      impale ,                                                       &
1287
901
      rtp    , rtpa   , propce , propfa , propfb ,                   &
1288
902
      coefa  , coefb  ,                                              &
1289
 
      ra(iflalf), ra(iflalb), ra(iprale), ra(icoale), ra(idepal),    &
1290
 
      rdevel , rtuser , ra  )
 
903
      flmalf , flmalb , xprale , cofale , depale )
1291
904
 
1292
905
    endif
1293
906
 
1299
912
 
1300
913
  if (itrfin.eq.1 .and. itrfup.eq.1) then
1301
914
 
1302
 
    call coupbi &
 
915
    call coupbi(nfabor, nvar, nscal, icodcl, rcodcl)
1303
916
    !==========
1304
 
  ( ifinia , ifinra ,                                              &
1305
 
    nfabor ,                                                       &
1306
 
    nvar   , nscal  , nphas  ,                                     &
1307
 
    nideve , nrdeve , nituse , nrtuse ,                            &
1308
 
    ia(iicodc) ,                                                   &
1309
 
    idevel , ituser , ia     ,                                     &
1310
 
    ra(ircodc) ,                                                   &
1311
 
    rdevel , rtuser , ra     )
1312
917
 
1313
918
    if (nfpt1t.gt.0) then
1314
919
      call cou1di &
1315
920
      !==========
1316
 
    ( ifinia , ifinra ,                                              &
1317
 
      nfabor ,                                                       &
1318
 
      nvar   , nscal  , nphas  ,                                     &
1319
 
      nideve , nrdeve , nituse , nrtuse ,                            &
1320
 
      isvtb  , ia(iicodc) ,                                          &
1321
 
      idevel , ituser , ia     ,                                     &
1322
 
      ra(ircodc) ,                                                   &
1323
 
      rdevel , rtuser , ra     )
 
921
    ( nfabor ,                                                       &
 
922
      nvar   , nscal  ,                                              &
 
923
      isvtb  , icodcl ,                                              &
 
924
      rcodcl )
1324
925
    endif
1325
926
 
1326
927
  endif
1328
929
 
1329
930
  if(iirayo.gt.0 .and. itrfin.eq.1 .and. itrfup.eq.1) then
1330
931
 
1331
 
    call memra3 &
1332
 
    !==========
1333
 
  ( ifinia , ifinra ,                                              &
1334
 
    ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1335
 
    nnod   , lndfac , lndfbr , ncelbr ,                            &
1336
 
    nvar   , nscal  , nphas  ,                                     &
1337
 
    iisoth , itek   , itext  , itint  ,                            &
1338
 
    ifinib , ifinrb )
1339
 
 
1340
932
    call raycli &
1341
933
    !==========
1342
 
  ( ifinib , ifinrb ,                                              &
1343
 
    ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1344
 
    nnod   , lndfac , lndfbr , ncelbr ,                            &
1345
 
    nvar   , nscal  , nphas  ,                                     &
1346
 
    nideve , nrdeve , nituse , nrtuse , isvhb  , isvtb  ,          &
1347
 
    ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
1348
 
    ipnfac , nodfac , ipnfbr , nodfbr ,                            &
1349
 
    ia(iicodc) , ia(iitrif)   , ia(iitypf)   ,                     &
1350
 
 
1351
 
    ia(iizfrd) , ia(iisoth)      ,                                 &
1352
 
 
1353
 
    idevel , ituser , ia     ,                                     &
1354
 
    xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
934
  ( nvar   , nscal  ,                                              &
 
935
    isvhb  , isvtb  ,                                              &
 
936
    icodcl , itrifb , itypfb ,                                     &
 
937
    izfrad ,                                                       &
1355
938
    dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
1356
 
    ra(ircodc)      ,                                              &
1357
 
    coefa  , coefb  , ra(ihbord)      , ra(itbord)      ,          &
1358
 
    ra(iw1), ra(iw2), ra(iw3), ra(iw4), ra(iw5), ra(iw6),          &
1359
 
 
1360
 
    ra(itext)  , ra(itint) ,  ra(itek)   ,                         &
1361
 
 
1362
 
    rdevel , rtuser , ra     )
 
939
    rcodcl ,                                                       &
 
940
    coefa  , coefb  , hbord  , tbord  )
1363
941
 
1364
942
  endif
1365
943
 
1367
945
 
1368
946
  call condli &
1369
947
  !==========
1370
 
( ifinia , ifinra ,                                              &
1371
 
  ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1372
 
  nnod   , lndfac , lndfbr , ncelbr ,                            &
1373
 
  nvar   , nscal  , nphas  ,                                     &
1374
 
  nideve , nrdeve , nituse , nrtuse , isvhb  , isvtb  ,          &
1375
 
  ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
1376
 
  ipnfac , nodfac , ipnfbr , nodfbr ,                            &
1377
 
  ia(iicodc)      , isostd ,                                     &
1378
 
  idevel , ituser , ia     ,                                     &
1379
 
  xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
948
( nvar   , nscal  ,                                              &
 
949
  isvhb  , isvtb  ,                                              &
 
950
  icodcl , isostd ,                                              &
1380
951
  dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
1381
 
  ra(ircodc)      ,                                              &
1382
 
  coefa  , coefb  , ra(iuetbo) , ra(ivsvdr)  ,                   &
1383
 
  ra(ihbord)  , ra(itbord)      ,                                &
1384
 
  frcxt  ,                                                       &
1385
 
  ra(iw1), ra(iw2), ra(iw3), ra(iw4), ra(iw5), ra(iw6),          &
1386
 
  ra(icoefu)      , ra(irijip)      ,                            &
1387
 
  rdevel , rtuser , ra     )
 
952
  rcodcl ,                                                       &
 
953
  coefa  , coefb  , visvdr ,                                     &
 
954
  hbord  , tbord  ,                                              &
 
955
  frcxt  )
1388
956
 
1389
957
 
1390
958
  !     UNE FOIS LES COEFFICIENTS CALCULES, ON PEUT EN DEDUIRE PLUS
1411
979
  endif
1412
980
 
1413
981
  ! On recupere le Cp de la phase couplee
1414
 
  !  (ou de la phase 1, si pas de couplage)
1415
 
  iphas = 1
1416
 
  if(isvtb.gt.0) then
1417
 
    iphas = iphsca(isvtb)
1418
 
  endif
1419
 
  if(icp(iphas).gt.0) then
1420
 
    ippcp = ipproc(icp(iphas))
 
982
  if(icp.gt.0) then
 
983
    ippcp = ipproc(icp)
1421
984
    ncp   = ncelet
1422
985
    cpcst = 0.d0
1423
986
  else
1424
 
    ippcp = ifinra
 
987
    ippcp = 1
1425
988
    ncp   = 1
1426
 
    cpcst = cp0(iphas)
 
989
    cpcst = cp0
1427
990
  endif
1428
991
 
1429
992
  ! En compressible et si on couple ave l'energie
1431
994
 
1432
995
  if ( ippmod(icompf).ge.0 .and. ientha .eq. 2 ) then
1433
996
 
1434
 
    iphas = iphsca(isvtb)
1435
 
    if(icv(iphas).gt.0) then
1436
 
      ippcv = ipproc(icv(iphas))
 
997
    if(icv.gt.0) then
 
998
      ippcv = ipproc(icv)
1437
999
      ncv   = ncelet
1438
1000
      cvcst = 0.d0
1439
1001
    else
1440
 
      ippcv = ifinra
 
1002
      ippcv = 1
1441
1003
      ncv   = 1
1442
 
      cvcst = cv0(iphas)
 
1004
      cvcst = cv0
1443
1005
    endif
1444
1006
  else
1445
 
    ippcv = ifinra
 
1007
    ippcv = 1
1446
1008
    ncv   = 1
1447
1009
    cvcst = 0.d0
1448
1010
  endif
1453
1015
 
1454
1016
    call coupbo &
1455
1017
    !==========
1456
 
  ( ifinia , ifinra ,                                              &
1457
 
    ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1458
 
    nnod   , lndfac , lndfbr , ncelbr ,                            &
1459
 
    nvar   , nscal  , nphas  , isvtb  ,                            &
1460
 
    nideve , nrdeve , nituse , nrtuse , ncp  , ncv , ientha ,      &
1461
 
    ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
1462
 
    ipnfac , nodfac , ipnfbr , nodfbr ,                            &
1463
 
    idevel , ituser , ia     ,                                     &
1464
 
    xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
1018
  ( nvar   , nscal  , isvtb  ,                                     &
 
1019
    ncp  , ncv , ientha ,                                          &
1465
1020
    dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
1466
1021
    coefa  , coefb  ,                                              &
1467
1022
    cpcst  , propce(1,ippcp) , cvcst  , propce(1,ippcv),           &
1468
 
    ra(ihbord)      , ra(itbord)      ,                            &
1469
 
    rdevel , rtuser , ra     )
 
1023
    hbord  , tbord  )
1470
1024
 
1471
1025
 
1472
1026
    if (nfpt1t.gt.0) then
1473
1027
      call cou1do &
1474
1028
      !==========
1475
 
    ( ifinia , ifinra ,                                              &
1476
 
      ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1477
 
      nnod   , lndfac , lndfbr , ncelbr ,                            &
1478
 
      nvar   , nscal  , nphas  , ncp    , nfpt1d ,                   &
1479
 
      nideve , nrdeve , nituse , nrtuse ,                            &
1480
 
      ifacel , ifabor , ifmfbr , ifmcel , iprfml,                    &
1481
 
      ipnfac , nodfac , ipnfbr , nodfbr ,                            &
1482
 
      ientha , ia(iifpt1), ia(iiclt1),                               &
1483
 
      idevel , ituser , ia     ,                                     &
1484
 
      xyzcen , surfac , surfbo , cdgfac , cdgfbo ,                   &
1485
 
      xyznod , volume ,                                              &
1486
 
      ra(itppt1), ra(itept1), ra(ihept1),                            &
1487
 
      ra(ifept1), ra(ixlmt1), ra(ircpt1), ra(idtpt1),                &
 
1029
    ( nvar   , nscal  , ncp    , nfpt1d ,                            &
 
1030
      ientha , ifpt1d , iclt1d ,                                     &
 
1031
      tppt1d , tept1d , hept1d ,                                     &
 
1032
      fept1d , xlmbt1 , rcpt1d , dtpt1d ,                            &
1488
1033
      dt     , rtpa   , propce , propfa , propfb ,                   &
1489
1034
      coefa  , coefb  ,                                              &
1490
 
      cpcst  , propce(1,ippcp) , ra(ihbord) , ra(itbord)  ,          &
1491
 
      rdevel , rtuser , ra     )
 
1035
      cpcst  , propce(1,ippcp) , hbord  , tbord  )
1492
1036
    endif
1493
1037
  endif
1494
1038
 
1510
1054
    endif
1511
1055
 
1512
1056
 
1513
 
    ! On ne fait le calcul que s'il y a des parois (RA(IDIPAR) est reserve
1514
 
    !   et initialise a GRAND avant. S'il n'y a pas de paroi, il restera = GRAND)
 
1057
    ! On ne fait le calcul que s'il y a des parois, 'dispar'  est reserve
 
1058
    ! et initialise a GRAND avant. S'il n'y a pas de paroi, il restera = GRAND)
1515
1059
 
1516
1060
    ! Pour le moment, on suppose que l'on peut se contenter de faire
1517
1061
    !  cela au premier passage, sauf avec les maillages mobiles. Attention donc
1523
1067
      if(ineedy.eq.1) then
1524
1068
        infpar = 0
1525
1069
        do ifac = 1, nfabor
1526
 
          if(ia(iitypf-1+ifac).eq.iparoi .or.                       &
1527
 
               ia(iitypf-1+ifac).eq.iparug) then
 
1070
          if (itypfb(ifac).eq.iparoi .or. itypfb(ifac).eq.iparug) then
1528
1071
            infpar = infpar+1
1529
1072
          endif
1530
1073
        enddo
1549
1092
      else
1550
1093
 
1551
1094
 
1552
 
        !     On doit conserver la memoire de memcli a cause de RA(IUETBO)
 
1095
        !     On doit conserver la memoire de memcli a cause de 'uetbor'
1553
1096
        !       dans DISTYP (uniquement en LES avec van Driest mais tant pis)
1554
1097
 
1555
 
        call memdis &
1556
 
        !==========
1557
 
    ( ifinia , ifinra ,                                              &
1558
 
      ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1559
 
      nnod   , lndfac , lndfbr , ncelbr ,                            &
1560
 
      nvar   , nscal  , nphas  ,                                     &
1561
 
      nideve , nrdeve , nituse , nrtuse ,                            &
1562
 
      iviscf , iviscb , idam   , ixam   , ismbr  , irovsd ,          &
1563
 
      irtdp  , icofay , icofby ,                                     &
1564
 
      iw1    , iw2    , iw3    , iw4    , iw5    , iw6    , iw7    , &
1565
 
      iw8    , iw9    ,                                              &
1566
 
      ifinib , ifinrb )
1567
 
 
1568
1098
        call distpr &
1569
1099
        !==========
1570
 
    ( ifinib , ifinrb ,                                              &
1571
 
      ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1572
 
      nnod   , lndfac , lndfbr , ncelbr ,                            &
1573
 
      nvar   , nscal  , nphas  ,                                     &
1574
 
      nideve , nrdeve , nituse , nrtuse ,                            &
1575
 
      ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
1576
 
      ipnfac , nodfac , ipnfbr , nodfbr , ia(iitypf)      ,          &
1577
 
      idevel , ituser , ia     ,                                     &
1578
 
      xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
1579
 
      ra(idipar)      ,                                              &
1580
 
      ra(iviscf)      , ra(iviscb)      ,                            &
1581
 
      ra(idam)        , ra(ixam)        ,                            &
1582
 
      ra(ismbr )      , ra(irovsd)      ,                            &
1583
 
      ra(irtdp)       , ra(icofay)      , ra(icofby)      ,          &
1584
 
      ra(iw1), ra(iw2), ra(iw3), ra(iw4), ra(iw5), ra(iw6), ra(iw7), &
1585
 
      ra(iw8), ra(iw9),                                              &
1586
 
      rdevel , rtuser , ra     )
 
1100
    ( nvar   , nscal  ,                                              &
 
1101
      itypfb ,                                                       &
 
1102
      dispar )
1587
1103
 
1588
1104
        !     La distance n'a plus a etre mise a jour sauf en ALE
1589
1105
        if (iale.eq.0) imajdy = 1
1598
1114
  !     OU CALCUL DE Y+ POUR LE LAGRANGIEN
1599
1115
 
1600
1116
 
1601
 
  do iphas = 1, nphas
1602
 
 
1603
 
    !       Pour passer en argument
1604
 
    iphass = iphas
1605
 
 
1606
 
    !     On calcule y+ si on en a besoin
1607
 
 
1608
 
    if( (itytur(iphas).eq.4.and.idries(iphas).eq.1)                 &
1609
 
         .or. (iilagr.ge.1 .and. iroule.eq.2) ) then
1610
 
 
1611
 
      !       On calcule si on a demande ce mode de calcul
1612
 
      !               et s'il y a des parois (si pas de paroi, pas de y+)
1613
 
      if(abs(icdpar).eq.1.and.infpar.gt.0) then
1614
 
 
1615
 
        iismph = iisymp+nfabor*(iphas-1)
1616
 
 
1617
 
        !     On doit conserver la memoire de memcli a cause de RA(IUETBO)
1618
 
        !       dans DISTYP
1619
 
 
1620
 
        call memdyp &
1621
 
        !==========
1622
 
      ( ifinia , ifinra ,                                              &
1623
 
        ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1624
 
        nnod   , lndfac , lndfbr , ncelbr ,                            &
1625
 
        nvar   , nscal  , nphas  ,                                     &
1626
 
        nideve , nrdeve , nituse , nrtuse ,                            &
1627
 
        idam   , ixam   , ismbr  , irovsd ,                            &
1628
 
        irtdp  , idrtdp ,                                              &
1629
 
        iqfx   , iqfy   , iqfz   , icoefq , iirho  , iirhob ,          &
1630
 
        iflua  , iflub  ,                                              &
1631
 
        icoax  , icobx  , icoay  , icoby  , icoaz  , icobz  ,          &
1632
 
        iw1    , iw2    , iw3    , iw4    , iw5    , iw6    , iw7    , &
1633
 
        iw8    , iw9    ,                                              &
1634
 
        ifinib , ifinrb )
1635
 
 
1636
 
        call distyp                                                 &
1637
 
        !==========
1638
 
      ( ifinib , ifinrb ,                                              &
1639
 
        ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1640
 
        nnod   , lndfac , lndfbr , ncelbr ,                            &
1641
 
        nvar   , nscal  , nphas  , iphass ,                            &
1642
 
        nideve , nrdeve , nituse , nrtuse ,                            &
1643
 
        ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
1644
 
        ipnfac , nodfac , ipnfbr , nodfbr ,                            &
1645
 
        ia(iitypf) , ia(iismph),                                       &
1646
 
        idevel , ituser , ia     ,                                     &
1647
 
        xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
1648
 
        ra(idipar), propce    , ra(iuetbo), ra(iyppar),                &
1649
 
        ra(idam  ), ra(ixam  ), ra(ismbr ), ra(irovsd),                &
1650
 
        ra(irtdp ), ra(idrtdp),                                        &
1651
 
        ra(iqfx  ), ra(iqfy  ), ra(iqfz  ), ra(icoefq),                &
1652
 
        ra(iirho ), ra(iirhob),                            &
1653
 
        ra(iflua ), ra(iflub ),                                        &
1654
 
        ra(icoax ), ra(icobx ), ra(icoay ), ra(icoby ),                &
1655
 
        ra(icoaz ), ra(icobz ),                            &
1656
 
        ra(iw1), ra(iw2), ra(iw3), ra(iw4), ra(iw5), ra(iw6), ra(iw7), &
1657
 
        ra(iw8), ra(iw9),                                              &
1658
 
        rdevel , rtuser , ra     )
1659
 
 
1660
 
      endif
1661
 
 
1662
 
    endif
1663
 
 
1664
 
    if (itytur(iphas).eq.4 .and. idries(iphas).eq.1) then
1665
 
 
1666
 
      !     Pas d'amortissement si pas de paroi
1667
 
      if(infpar.gt.0) then
1668
 
        if(iifapa(iphas).gt.0) then
1669
 
          iiifap = iifapa(iphas)
1670
 
        else
1671
 
          iiifap = ifinib
1672
 
        endif
1673
 
        call vandri &
1674
 
        !==========
1675
 
      ( ndim   , ncelet , ncel   , nfac   , nfabor , nphas ,         &
1676
 
        nideve , nrdeve , nituse , nrtuse , iphass ,                 &
1677
 
        ia(iitypf) , ifabor, ia(iiifap),                             &
1678
 
        idevel , ituser , ia     ,                                   &
1679
 
        xyzcen , cdgfbo , ra(iuetbo) , ra(ivsvdr) , ra(iyppar) ,     &
1680
 
        propce , rdevel , rtuser , ra     )
1681
 
      endif
1682
 
 
1683
 
    endif
1684
 
 
1685
 
  enddo
 
1117
  !     On calcule y+ si on en a besoin
 
1118
 
 
1119
  if( (itytur.eq.4.and.idries.eq.1)                 &
 
1120
       .or. (iilagr.ge.1 .and. iroule.eq.2) ) then
 
1121
 
 
1122
    !       On calcule si on a demande ce mode de calcul
 
1123
    !               et s'il y a des parois (si pas de paroi, pas de y+)
 
1124
    if(abs(icdpar).eq.1.and.infpar.gt.0) then
 
1125
 
 
1126
      !     On doit conserver la memoire de memcli a cause de 'uetbor'
 
1127
      !       dans DISTYP
 
1128
 
 
1129
      call distyp                                                 &
 
1130
      !==========
 
1131
    ( nvar   , nscal  ,                                              &
 
1132
      itypfb ,                                                       &
 
1133
      dispar , propce    , yplpar )
 
1134
 
 
1135
    endif
 
1136
 
 
1137
  endif
 
1138
 
 
1139
  if (itytur.eq.4 .and. idries.eq.1) then
 
1140
 
 
1141
    !     Pas d'amortissement si pas de paroi
 
1142
    if(infpar.gt.0) then
 
1143
      call vandri &
 
1144
      !==========
 
1145
    ( ndim   , ncelet , ncel   , nfac   , nfabor ,                 &
 
1146
      itypfb , ifabor , ifapat,                                    &
 
1147
      xyzcen , cdgfbo , visvdr , yplpar ,                          &
 
1148
      propce )
 
1149
    endif
 
1150
 
 
1151
  endif
1686
1152
 
1687
1153
  if(ineedy.eq.1.and.iwarny.ge.1) then
1688
1154
    call dmtmps(tdist2)
1692
1158
    write(nfecra,4010)tditot
1693
1159
  endif
1694
1160
 
 
1161
  ! Free memory
 
1162
  deallocate(icodcl, rcodcl)
 
1163
  if (allocated(hbord)) deallocate(hbord)
 
1164
  if (allocated(tbord)) deallocate(tbord)
 
1165
  if (allocated(visvdr)) deallocate(visvdr)
1695
1166
 
1696
1167
!===============================================================================
1697
1168
! 10. DANS LE CAS  "zero pas de temps" EN "NON SUITE" DE CALCUL
1710
1181
 
1711
1182
    if (itrale.eq.0 .or. itrale.gt.nalinf) then
1712
1183
 
1713
 
      call memale &
1714
 
      !==========
1715
 
    ( idbia1 , idbra1 ,                                              &
1716
 
      ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1717
 
      nnod   , lndfac , lndfbr , ncelbr ,                            &
1718
 
      nvar   , nscal  , nphas  ,                                     &
1719
 
      nideve , nrdeve , nituse , nrtuse ,                            &
1720
 
      iviscf , iviscb , idam   , ixam   ,                            &
1721
 
      idrtp  , ismbr  , irovsd ,                                     &
1722
 
      iw1    , iw2    , iw3    , iw4    , iw5    , iw6    , iw7    , &
1723
 
      iw8    , iw9    ,                                              &
1724
 
      ifinia , ifinra )
1725
 
 
1726
1184
      call alelap &
1727
1185
      !==========
1728
 
    ( ifinia , ifinra ,                                              &
1729
 
      ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1730
 
      nnod   , lndfac , lndfbr , ncelbr ,                            &
1731
 
      nvar   , nscal  , nphas  ,                                     &
1732
 
      nideve , nrdeve , nituse , nrtuse ,                            &
1733
 
      ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
1734
 
      ipnfac , nodfac , ipnfbr , nodfbr ,                            &
1735
 
      idevel , ituser , ia     ,                                     &
1736
 
      xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
1186
    ( nvar   , nscal  ,                                              &
1737
1187
      dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
1738
 
      coefa  , coefb  ,                                              &
1739
 
      ra(iviscf) , ra(iviscb) ,                                      &
1740
 
      ra(idam  ) , ra(ixam  ) ,                                      &
1741
 
      ra(idrtp ) , ra(ismbr ) , ra(irovsd) ,                         &
1742
 
      ra(iw1   ) , ra(iw2   ) , ra(iw3   ) , ra(iw4   ),             &
1743
 
      ra(iw5   ) , ra(iw6   ) , ra(iw7   ) , ra(iw8   ) , ra(iw9   ),&
1744
 
      rdevel , rtuser , ra     )
 
1188
      coefa  , coefb  )
1745
1189
 
1746
1190
    endif
1747
1191
 
1766
1210
    ! Le module compressible n'est pas compatible avec la boucle U/P
1767
1211
    if ( ippmod(icompf).ge.0 ) then
1768
1212
 
1769
 
      if(iwarni(iu(1)).ge.1) then
 
1213
      if(iwarni(iu).ge.1) then
1770
1214
        write(nfecra,1080)
1771
1215
      endif
1772
1216
 
1773
 
      call memcfm &
 
1217
      iscal = irho
 
1218
 
 
1219
      call cfmsvl &
1774
1220
      !==========
1775
 
    ( idbia1 , idbra1 ,                                              &
1776
 
      ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1777
 
      nnod   , lndfac , lndfbr , ncelbr ,                            &
1778
 
      nvar   , nscal  , nphas  ,                                     &
1779
 
      nideve , nrdeve , nituse , nrtuse ,                            &
1780
 
      idtr   , iviscf , iviscb , idam   , ixam   ,                   &
1781
 
      idrtp  , ismbr  , irovsd ,                                     &
1782
 
      iw1    , iw2    , iw3    , iw4    , iw5    , iw6    ,          &
1783
 
      iw7    , iw8    , iw9    , iw10   , iw11   , iw12   ,          &
1784
 
      iwflms , iwflmb ,                                              &
1785
 
      icoefu ,                                                       &
1786
 
      ifinia , ifinra )
1787
 
 
1788
 
      do iphas = 1, nphas
1789
 
 
1790
 
        iscal = irho(iphas)
1791
 
 
1792
 
        call cfmsvl &
1793
 
        !==========
1794
 
      ( ifinia , ifinra ,                                              &
1795
 
        ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1796
 
        nnod   , lndfac , lndfbr , ncelbr ,                            &
1797
 
        nvar   , nscal  , nphas  ,                                     &
1798
 
        ncepdc(iphas)   , ncetsm(iphas)   ,                            &
1799
 
        nideve , nrdeve , nituse , nrtuse , iscal  ,                   &
1800
 
        ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
1801
 
        ipnfac , nodfac , ipnfbr , nodfbr ,                            &
1802
 
        ia(iicepd(iphas))        , ia(iicesm(iphas))       ,           &
1803
 
        ia(iitpsm(iphas))        ,                                     &
1804
 
        idevel , ituser , ia     ,                                     &
1805
 
        xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
1806
 
        dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
1807
 
        coefa  , coefb  ,                                              &
1808
 
        ra(ickupd(iphas))        , ra(ismace(iphas))        ,          &
1809
 
        ra(iviscf) , ra(iviscb)  ,                                     &
1810
 
        ra(idam  ) , ra(ixam  )  ,                                     &
1811
 
        ra(idrtp ) , ra(ismbr )  , ra(irovsd) ,                        &
1812
 
        ra(iw1   ) , ra(iw2   )  , ra(iw3   ) ,                        &
1813
 
        ra(iw4   ) , ra(iw5   )  , ra(iw6   ) ,                        &
1814
 
        ra(iw7   ) , ra(iw8   )  , ra(iw9   ) ,                        &
1815
 
        ra(iw10  ) , ra(iw11  )  , ra(iw12  ) ,                        &
1816
 
        ra(iwflms) , ra(iwflmb)  ,                                     &
1817
 
        ra(icoefu) ,                                                   &
1818
 
        rdevel , rtuser , ra     )
1819
 
 
1820
 
      enddo
 
1221
    ( nvar   , nscal  ,                                              &
 
1222
      ncepdc , ncetsm ,                                              &
 
1223
      iscal  ,                                                       &
 
1224
      icepdc , icetsm ,                                              &
 
1225
      itypsm ,                                                       &
 
1226
      dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
 
1227
      coefa  , coefb  ,                                              &
 
1228
      ckupdc , smacel )
1821
1229
 
1822
1230
    endif
1823
1231
 
1825
1233
! 13. RESOLUTION QUANTITE DE MOUVEMENT ET MASSE (INCOMPRESSIBLE)
1826
1234
!===============================================================================
1827
1235
 
1828
 
    if(iwarni(iu(1)).ge.1) then
 
1236
    if(iwarni(iu).ge.1) then
1829
1237
      write(nfecra,1040)
1830
1238
    endif
1831
1239
 
1832
 
    call memnav &
1833
 
    !==========
1834
 
  ( idbia1 , idbra1 ,                                              &
1835
 
    ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1836
 
    nnod   , lndfac , lndfbr , ncelbr ,                            &
1837
 
    nvar   , nscal  , nphas  ,                                     &
1838
 
    nideve , nrdeve , nituse , nrtuse ,                            &
1839
 
    iviscf , iviscb , ivisfi , ivisbi ,                            &
1840
 
    idam   , ixam   ,                                              &
1841
 
    idrtp  , igrdp  , ismbr  , irovsd ,                            &
1842
 
    iw1    , iw2    , iw3    , iw4    , iw5    , iw6    , iw7    , &
1843
 
    iw8    , iw9    , iw10   , idfrcx , ifrchy , idfrhy ,          &
1844
 
    icoefu , iesflm , iesflb ,                                     &
1845
 
    ifinia , ifinra )
1846
 
 
1847
1240
    !     SI LE COMPRESSIBLE SANS CHOC EST ACTIF, ON RESOUT AVEC CFQDMV
1848
1241
    if ( ippmod(icompf).ge.0 ) then
1849
1242
 
1850
 
      do iphas = 1, nphas
1851
 
 
1852
 
        iuiph  = iu(iphas)
1853
 
        iflmas = ipprof(ifluma(iuiph))
1854
 
        iflmab = ipprob(ifluma(iuiph))
1855
 
        iph    = iphas
1856
 
 
1857
 
        call cfqdmv &
1858
 
        !==========
1859
 
      ( ifinia , ifinra ,                                              &
1860
 
        ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1861
 
        nnod   , lndfac , lndfbr , ncelbr ,                            &
1862
 
        nvar   , nscal  , nphas  ,                                     &
1863
 
        ncepdc(iphas)   , ncetsm(iphas)   ,                            &
1864
 
        nideve , nrdeve , nituse , nrtuse , iph    ,                   &
1865
 
        ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
1866
 
        ipnfac , nodfac , ipnfbr , nodfbr ,                            &
1867
 
        ia(iicepd(iphas))        , ia(iicesm(iphas))       ,           &
1868
 
        ia(iitpsm(iphas))        ,                                     &
1869
 
        idevel , ituser , ia     ,                                     &
1870
 
        xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
1871
 
        dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
1872
 
        propfa(1,iflmas), propfb(1,iflmab),                            &
1873
 
        coefa  , coefb  ,                                              &
1874
 
        ra(ickupd(iphas))        , ra(ismace(iphas))        ,          &
1875
 
        frcxt  , ra(idfrcx)      , ra(itpuco)      , ra(igrdp)       , &
1876
 
        ra(iviscf) , ra(iviscb)  , ra(ivisfi) , ra(ivisbi)  ,          &
1877
 
        ra(idam  ) , ra(ixam  )  ,                                     &
1878
 
        ra(idrtp ) , ra(ismbr )  , ra(irovsd) ,                        &
1879
 
        ra(iw1   ) , ra(iw2   )  , ra(iw3   ) ,                        &
1880
 
        ra(iw4   ) , ra(iw5   )  , ra(iw6   ) ,                        &
1881
 
        ra(iw7   ) , ra(iw8   )  , ra(iw9   ) ,                        &
1882
 
        ra(icoefu) ,                                                   &
1883
 
        rdevel , rtuser , ra     )
1884
 
 
1885
 
      enddo
1886
 
 
1887
 
    else
1888
 
 
1889
 
      call navsto &
 
1243
      iflmas = ipprof(ifluma(iu))
 
1244
      iflmab = ipprob(ifluma(iu))
 
1245
 
 
1246
      call cfqdmv &
1890
1247
      !==========
1891
 
    ( ifinia , ifinra ,                                              &
1892
 
      ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1893
 
      nnod   , lndfac , lndfbr , ncelbr ,                            &
1894
 
      nvar   , nscal  , nphas  , iterns , icvrge ,                   &
1895
 
      nideve , nrdeve , nituse , nrtuse ,                            &
1896
 
      ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
1897
 
      ipnfac , nodfac , ipnfbr , nodfbr ,                            &
1898
 
      isostd ,                                                       &
1899
 
      idevel , ituser , ia     ,                                     &
1900
 
      xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
1248
    ( nvar   , nscal  ,                                              &
 
1249
      ncepdc , ncetsm ,                                              &
 
1250
      icepdc , icetsm ,                                              &
 
1251
      itypsm ,                                                       &
1901
1252
      dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
1902
 
      tslagr , coefa  , coefb  , frcxt  ,                            &
1903
 
      ra(itrava) , ra(iximpa) , ra(iuvwk ) ,                         &
1904
 
      ra(iviscf) , ra(iviscb) , ra(ivisfi) , ra(ivisbi) ,            &
1905
 
      ra(idam  ) , ra(ixam  ) ,                                      &
1906
 
      ra(idrtp ) , ra(igrdp ) , ra(ismbr ) , ra(irovsd) ,            &
1907
 
      ra(iw1   ) , ra(iw2   ) , ra(iw3   ) ,                         &
1908
 
      ra(iw4   ) , ra(iw5   ) , ra(iw6   ) ,                         &
1909
 
      ra(iw7   ) , ra(iw8   ) , ra(iw9   ) , ra(iw10  ) ,            &
1910
 
      ra(idfrcx) , ra(ifrchy) , ra(idfrhy) ,                         &
1911
 
      ra(icoefu) , ra(iesflm) , ra(iesflb),                          &
1912
 
      rdevel , rtuser , ra     )
 
1253
      propfa(1,iflmas), propfb(1,iflmab),                            &
 
1254
      coefa  , coefb  ,                                              &
 
1255
      ckupdc , smacel ,                                              &
 
1256
      frcxt  , tpucou )
 
1257
 
 
1258
    else
 
1259
 
 
1260
      if (ivelco.eq.0) then
 
1261
 
 
1262
        call navsto &
 
1263
        !==========
 
1264
      ( nvar   , nscal  , iterns , icvrge ,                            &
 
1265
        isostd ,                                                       &
 
1266
        dt     , tpucou , rtp    , rtpa   , propce , propfa , propfb , &
 
1267
        tslagr , coefa  , coefb  , frcxt  ,                            &
 
1268
        trava  , ximpa  , uvwk   )
 
1269
 
 
1270
      else
 
1271
 
 
1272
        ! Coupled solving of the velocity components
 
1273
 
 
1274
         call navstv &
 
1275
        !==========
 
1276
      ( nvar   , nscal  , iterns , icvrge ,                            &
 
1277
        isostd ,                                                       &
 
1278
        dt     , tpucou , rtp    , rtpa   , propce , propfa , propfb , &
 
1279
        tslagr , coefa  , coefb  , frcxt  ,                            &
 
1280
        trava  , ximpav , uvwk   )
 
1281
 
 
1282
      endif
 
1283
 
 
1284
 
1913
1285
 
1914
1286
      !     Mise a jour de la pression si on utilise un couplage vitesse/pression
1915
1287
      !       par point fixe
1916
1288
      !     En parallele, l'echange est fait au debut de navsto.
1917
1289
      if(nterup.gt.1) then
1918
 
        do iphas = 1, nphas
1919
 
          ipriph  = ipr(iphas)
1920
 
          do iel = 1, ncel
1921
 
            rtpa(iel,ipriph) = rtp(iel,ipriph)
1922
 
          enddo
 
1290
        do iel = 1, ncel
 
1291
          rtpa(iel,ipr) = rtp(iel,ipr)
1923
1292
        enddo
1924
1293
      endif
1925
1294
 
1943
1312
 
1944
1313
      endif
1945
1314
 
1946
 
      !     Si ISTMPF(IPHAS).EQ.0 (explicite) on ne traite pas le flux de
 
1315
      !     Si ISTMPF.EQ.0 (explicite) on ne traite pas le flux de
1947
1316
      !       masse a la derniere iteration
1948
1317
      !     Sinon on traite le flux de masse a toutes les iterations
1949
1318
 
1950
1319
      !     On teste le flux de masse de la phase 1 (toutes les phases sont
1951
1320
      !     necessairement traitees de la meme facon, cf. VERINI)
1952
 
      if( (istmpf(1).eq.0.and.inslst.eq.0) .or. istmpf(1).ne.0) then
 
1321
      if( (istmpf.eq.0.and.inslst.eq.0) .or. istmpf.ne.0) then
1953
1322
        iappel = 3
1954
1323
        call schtmp &
1955
1324
        !==========
1956
 
      ( idbia1 , idbra1 ,                                              &
1957
 
        ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1958
 
        nnod   , lndfac , lndfbr , ncelbr ,                            &
1959
 
        nvar   , nscal  , nphas  , iappel ,                            &
1960
 
        nideve , nrdeve , nituse , nrtuse ,                            &
1961
 
        ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
1962
 
        ipnfac , nodfac , ipnfbr , nodfbr , isostd ,                   &
1963
 
        idevel , ituser , ia     ,                                     &
1964
 
        xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
1325
      ( nvar   , nscal  , iappel ,                                     &
 
1326
        isostd ,                                                       &
1965
1327
        dt     , rtpa   , rtp    , propce , propfa , propfb ,          &
1966
 
        coefa  , coefb  ,                                              &
1967
 
        rdevel , rtuser ,                                              &
1968
 
        ra     )
 
1328
        coefa  , coefb  )
1969
1329
      endif
1970
1330
 
1971
1331
      if (inslst.eq.1) goto 100
1980
1340
 
1981
1341
100 continue
1982
1342
 
 
1343
! Free memory
 
1344
if (nterup.gt.1) then
 
1345
  deallocate(uvwk)
 
1346
  deallocate(ximpa)
 
1347
  deallocate(trava)
 
1348
endif
 
1349
 
1983
1350
! Calcul sur champ de vitesse fige SUITE (a cause de la boule U/P)
1984
1351
if (iccvfg.eq.0) then
1985
1352
!===============
1992
1359
 
1993
1360
    call strdep &
1994
1361
    !==========
1995
 
  ( idbia1 , idbra1 , itrale , italim , itrfin ,                   &
1996
 
    ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1997
 
    nnod   , lndfac , lndfbr , ncelbr , nvar   ,                   &
1998
 
    nideve , nrdeve , nituse , nrtuse ,                            &
1999
 
    ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
2000
 
    ipnfac , nodfac , ipnfbr , nodfbr ,                            &
2001
 
    idevel , ituser , ia     ,                                     &
2002
 
    xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
1362
  ( itrale , italim , itrfin ,                                     &
 
1363
    nvar   ,                                                       &
2003
1364
    dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
2004
1365
    coefa  , coefb  ,                                              &
2005
 
    ra(iflalf), ra(iflalb), ra(icoale), ra(iprale), ra(idepal),    &
2006
 
    rdevel , rtuser ,                                              &
2007
 
    ra     )
 
1366
    flmalf , flmalb , cofale , xprale )
2008
1367
 
2009
1368
    !     On boucle eventuellement sur de deplacement des structures
2010
1369
    if (itrfin.ne.-1) then
2012
1371
      goto 300
2013
1372
    endif
2014
1373
 
 
1374
    ! Free memory
 
1375
    deallocate(flmalf, flmalb)
 
1376
    deallocate(cofale)
 
1377
    deallocate(xprale)
 
1378
 
2015
1379
  endif
2016
1380
 
2017
 
  ! --- On libere les tableaux IFLALF, IFLALB ICOALE et IPRALE
2018
 
 
2019
 
  !     On ne passe dans SCHTMP que si ISTMPF(IPHAS).EQ.0 (explicite)
 
1381
  !     On ne passe dans SCHTMP que si ISTMPF.EQ.0 (explicite)
2020
1382
  !     On teste le flux de masse de la phase 1 (toutes les phases sont
2021
1383
  !     necessairement traitees de la meme facon, cf. VERINI)
2022
1384
  !     pour conserver
2023
 
  if( istmpf(1).eq.0 ) then
 
1385
  if( istmpf.eq.0 ) then
2024
1386
    iappel = 4
2025
1387
    call schtmp &
2026
1388
    !==========
2027
 
  ( idebia , idebra ,                                              &
2028
 
    ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
2029
 
    nnod   , lndfac , lndfbr , ncelbr ,                            &
2030
 
    nvar   , nscal  , nphas  , iappel ,                            &
2031
 
    nideve , nrdeve , nituse , nrtuse ,                            &
2032
 
    ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
2033
 
    ipnfac , nodfac , ipnfbr , nodfbr , isostd ,                   &
2034
 
    idevel , ituser , ia     ,                                     &
2035
 
    xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
1389
  ( nvar   , nscal  , iappel ,                                     &
 
1390
    isostd ,                                                       &
2036
1391
    dt     , rtpa   , rtp    , propce , propfa , propfb ,          &
2037
 
    coefa  , coefb  ,                                              &
2038
 
    rdevel , rtuser ,                                              &
2039
 
    ra     )
 
1392
    coefa  , coefb  )
2040
1393
  endif
2041
1394
 
2042
1395
!===============================================================================
2044
1397
!===============================================================================
2045
1398
 
2046
1399
  iok = 0
2047
 
  if(iwarni(iu(1)).ge.1) then
2048
 
    do iphas = 1, nphas
2049
 
      if( itytur(iphas).eq.2 .or. itytur(iphas).eq.3              &
2050
 
           .or. iturb(iphas).eq.50 .or. iturb(iphas).eq.60 ) then
2051
 
        iok = 1
2052
 
      endif
2053
 
    enddo
 
1400
  if(iwarni(iu).ge.1) then
 
1401
    if( itytur.eq.2 .or. itytur.eq.3              &
 
1402
         .or. itytur.eq.5 .or. iturb.eq.60 ) then
 
1403
      iok = 1
 
1404
    endif
2054
1405
    if(iok.eq.1) then
2055
1406
      write(nfecra,1050)
2056
1407
    endif
2057
1408
  endif
2058
1409
 
2059
 
  do iphas = 1, nphas
2060
 
 
2061
 
!     Si on est en v2f, on reserve un tableau de taille NCELET pour
2062
 
!     eviter de recalculer la production dans RESV2F (trois appels
2063
 
!     a GRDCEL)
2064
 
    idbia1 = idebia
2065
 
    idbra1 = idebra
2066
 
    iprv2f = idebra
2067
 
    if (iturb(iphas).eq.50) then
2068
 
      idbra1 = iprv2f + ncelet
2069
 
!     Pas la peine de tester les depassements de tableaux puisqu'on
2070
 
!     passe juste apres dans MEMKEP
2071
 
    endif
2072
 
 
2073
 
    if( (itytur(iphas).eq.2) .or. (iturb(iphas).eq.50) ) then
2074
 
 
2075
 
      ikiph  = ik  (iphas)
2076
 
 
2077
 
      call memkep &
2078
 
      !==========
2079
 
    ( idbia1 , idbra1 ,                                              &
2080
 
      ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
2081
 
      nnod   , lndfac , lndfbr , ncelbr ,                            &
2082
 
      nvar   , nscal  , nphas  ,                                     &
2083
 
      nideve , nrdeve , nituse , nrtuse ,                            &
2084
 
      idtr   , iviscf , iviscb , idam   , ixam   ,                   &
2085
 
      idrtp  , ismbr  , irovsd , itinsk , itinse , idivu ,           &
2086
 
      iw1    , iw2    , iw3    , iw4    , iw5    , iw6    , iw7    , &
2087
 
      iw8    , iw9    ,                                              &
2088
 
      ifinia , ifinra )
2089
 
 
2090
 
      if(cdtvar(ikiph).ne.1.d0) then
2091
 
        do iel = 1, ncel
2092
 
          ra(idtr-1+iel) = dt(iel)*cdtvar(ikiph)
2093
 
        enddo
2094
 
      else
2095
 
        do iel = 1, ncel
2096
 
          ra(idtr-1+iel) = dt(iel)
2097
 
        enddo
2098
 
      endif
2099
 
 
2100
 
      call turbke &
2101
 
      !==========
2102
 
    ( ifinia , ifinra ,                                              &
2103
 
      ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
2104
 
      nnod   , lndfac , lndfbr , ncelbr ,                            &
2105
 
      nvar   , nscal  , nphas  ,                                     &
2106
 
      ncepdc(iphas) , ncetsm(iphas) ,                                &
2107
 
      nideve , nrdeve , nituse , nrtuse , iphas  ,                   &
2108
 
      ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
2109
 
      ipnfac , nodfac , ipnfbr , nodfbr ,                            &
2110
 
      ia(iicepd(iphas)) , ia(iicesm(iphas)) , ia(iitpsm(iphas)) ,    &
2111
 
      idevel , ituser , ia     ,                                     &
2112
 
      xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
2113
 
      ra(idtr) , rtp    , rtpa   , propce , propfa , propfb ,        &
2114
 
      tslagr   ,                                                     &
2115
 
      coefa  , coefb  , ra(ickupd(iphas)) , ra(ismace(iphas)) ,      &
2116
 
      ra(iviscf) , ra(iviscb) , ra(iprv2f),                          &
2117
 
      ra(idam  ) , ra(ixam  ) ,                                      &
2118
 
      ra(idrtp ) , ra(ismbr ) , ra(irovsd) , ra(itinsk) , ra(itinse),&
2119
 
      ra(idivu ) , ra(iw1   ) , ra(iw2   ) , ra(iw3   ) , ra(iw4   ),&
2120
 
      ra(iw5   ) , ra(iw6   ) , ra(iw7   ) , ra(iw8   ) , ra(iw9   ),&
2121
 
      rdevel , rtuser , ra     )
2122
 
 
2123
 
      if( iturb(iphas).eq.50 )  then
2124
 
 
2125
 
        iphiph  = iphi(iphas)
2126
 
 
2127
 
        call memv2f &
2128
 
        !==========
2129
 
      ( idbia1 , idbra1 ,                                              &
2130
 
        ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
2131
 
        nnod   , lndfac , lndfbr , ncelbr ,                            &
2132
 
        nvar   , nscal  , nphas  ,                                     &
2133
 
        nideve , nrdeve , nituse , nrtuse ,                            &
2134
 
        idtr   , iviscf , iviscb , idam   , ixam   ,                   &
2135
 
        idrtp  , ismbr  , irovsd ,                                     &
2136
 
        iw1    , iw2    , iw3    , iw4    , iw5    , iw6    , iw7    , &
2137
 
        iw8    , iw9    , iw10   ,                                     &
2138
 
        ifinia , ifinra )
2139
 
 
2140
 
        if(cdtvar(iphiph).ne.1.d0) then
2141
 
          do iel = 1, ncel
2142
 
            ra(idtr-1+iel) = dt(iel)*cdtvar(iphiph)
2143
 
          enddo
2144
 
        else
2145
 
          do iel = 1, ncel
2146
 
            ra(idtr-1+iel) = dt(iel)
2147
 
          enddo
2148
 
        endif
2149
 
 
2150
 
        call resv2f &
2151
 
        !==========
2152
 
      ( ifinia , ifinra ,                                              &
2153
 
        ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
2154
 
        nnod   , lndfac , lndfbr , ncelbr ,                            &
2155
 
        nvar   , nscal  , nphas  ,                                     &
2156
 
        ncepdc(iphas) , ncetsm(iphas) ,                                &
2157
 
        nideve , nrdeve , nituse , nrtuse , iphas  ,                   &
2158
 
        ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
2159
 
        ipnfac , nodfac , ipnfbr , nodfbr ,                            &
2160
 
        ia(iicepd(iphas)) , ia(iicesm(iphas)) , ia(iitpsm(iphas)) ,    &
2161
 
        idevel , ituser , ia     ,                                     &
2162
 
        xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
2163
 
        ra(idtr) , rtp    , rtpa   , propce , propfa , propfb ,        &
2164
 
        coefa  , coefb  , ra(ickupd(iphas)) , ra(ismace(iphas)) ,      &
2165
 
        ra(iviscf) , ra(iviscb) , ra(iprv2f),                          &
2166
 
        ra(idam  ) , ra(ixam  ) ,                                      &
2167
 
        ra(idrtp ) , ra(ismbr ) , ra(irovsd) ,                         &
2168
 
        ra(iw1   ) , ra(iw2   ) , ra(iw3   ) , ra(iw4   ),             &
2169
 
        ra(iw5   ) , ra(iw6   ) , ra(iw7   ) , ra(iw8   ) , ra(iw9   ),&
2170
 
        ra(iw10  ) , rdevel , rtuser , ra     )
2171
 
 
2172
 
      endif
2173
 
 
2174
 
      !  RELAXATION DE K ET EPSILON SI IKECOU=0 EN INSTATIONNAIRE
2175
 
      if (ikecou(iphas).eq.0 .and. idtvar.ge.0) then
2176
 
        ikiph  = ik (iphas)
2177
 
        ieiph  = iep(iphas)
2178
 
        relaxk = relaxv(ikiph)
2179
 
        relaxe = relaxv(ieiph)
2180
 
        do iel = 1,ncel
2181
 
          rtp(iel,ikiph) = relaxk*rtp(iel,ikiph) + (1.d0-relaxk)*rtpa(iel,ikiph)
2182
 
          rtp(iel,ieiph) = relaxe*rtp(iel,ieiph) + (1.d0-relaxe)*rtpa(iel,ieiph)
2183
 
        enddo
2184
 
      endif
2185
 
 
2186
 
    else if(itytur(iphas).eq.3) then
2187
 
 
2188
 
      ir11ip = ir11(iphas)
2189
 
 
2190
 
      call memrij &
2191
 
      !==========
2192
 
    ( idebia , idebra ,                                              &
2193
 
      ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
2194
 
      nnod   , lndfac , lndfbr , ncelbr ,                            &
2195
 
      nvar   , nscal  , nphas  ,                                     &
2196
 
      nideve , nrdeve , nituse , nrtuse , iturb(iphas) ,             &
2197
 
      idtr   , iviscf , iviscb , icoefx ,                            &
2198
 
      idam   , ixam   , idrtp  ,                                     &
2199
 
      ismbr  , irovsd , igrdvt , iprodu , igrarx , igrary , igrarz , &
2200
 
      iw1    , iw2    , iw3    , iw4    , iw5    , iw6    , iw7    , &
2201
 
      iw8    , iw9    ,                                              &
2202
 
      ifinia , ifinra )
2203
 
 
2204
 
      if(cdtvar(ir11ip).ne.1.d0) then
2205
 
        do iel = 1, ncel
2206
 
          ra(idtr-1+iel) = dt(iel)*cdtvar(ir11ip)
2207
 
        enddo
2208
 
      else
2209
 
        do iel = 1, ncel
2210
 
          ra(idtr-1+iel) = dt(iel)
2211
 
        enddo
2212
 
      endif
2213
 
 
2214
 
      call turrij &
2215
 
      !==========
2216
 
    ( ifinia , ifinra ,                                              &
2217
 
      ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
2218
 
      nnod   , lndfac , lndfbr , ncelbr ,                            &
2219
 
      nvar   , nscal  , nphas  ,                                     &
2220
 
      ncepdc(iphas) , ncetsm(iphas) ,                                &
2221
 
      nideve , nrdeve , nituse , nrtuse , iphas  ,                   &
2222
 
      ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
2223
 
      ipnfac , nodfac , ipnfbr , nodfbr ,                            &
2224
 
      ia(iicepd(iphas)) , ia(iicesm(iphas)) , ia(iitpsm(iphas)) ,    &
2225
 
      idevel , ituser , ia     ,                                     &
2226
 
      xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
2227
 
      ra(idtr) , rtp    , rtpa   , propce , propfa , propfb ,        &
2228
 
      tslagr   ,                                                     &
2229
 
      coefa  , coefb  , ra(ickupd(iphas)) , ra(ismace(iphas)) ,      &
2230
 
      ra(iviscf) , ra(iviscb) , ra(icoefx),                          &
2231
 
      ra(idam  ) , ra(ixam  ) ,                                      &
2232
 
      ra(idrtp ) , ra(ismbr ) , ra(irovsd) , ra(igrdvt) ,            &
2233
 
      ra(iprodu) , ra(igrarx) , ra(igrary) , ra(igrarz) ,            &
2234
 
      ra(iw1   ) , ra(iw2   ) , ra(iw3   ) , ra(iw4   ) ,            &
2235
 
      ra(iw5   ) , ra(iw6   ) , ra(iw7   ) , ra(iw8   ) , ra(iw9   ),&
2236
 
      rdevel , rtuser , ra     )
2237
 
 
2238
 
    else if( iturb(iphas).eq.60 ) then
2239
 
 
2240
 
      ikiph  = ik  (iphas)
2241
 
 
2242
 
      call memkom &
2243
 
      !==========
2244
 
    ( idebia , idebra ,                                              &
2245
 
      ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
2246
 
      nnod   , lndfac , lndfbr , ncelbr ,                            &
2247
 
      nvar   , nscal  , nphas  ,                                     &
2248
 
      nideve , nrdeve , nituse , nrtuse ,                            &
2249
 
      idtr   , iviscf , iviscb , idam   , ixam   ,                   &
2250
 
      idrtp  , ismbr  , irovsd , itinsk , itinse , idivu  ,          &
2251
 
      iw1    , iw2    , iw3    , iw4    , iw5    , iw6    , iw7    , &
2252
 
      iw8    , iw9    ,                                              &
2253
 
      ifinia , ifinra )
2254
 
 
2255
 
      if(cdtvar(ikiph).ne.1.d0) then
2256
 
        do iel = 1, ncel
2257
 
          ra(idtr-1+iel) = dt(iel)*cdtvar(ikiph)
2258
 
        enddo
2259
 
      else
2260
 
        do iel = 1, ncel
2261
 
          ra(idtr-1+iel) = dt(iel)
2262
 
        enddo
2263
 
      endif
2264
 
 
2265
 
      call turbkw                                                 &
2266
 
      !==========
2267
 
    ( ifinia , ifinra ,                                              &
2268
 
      ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
2269
 
      nnod   , lndfac , lndfbr , ncelbr ,                            &
2270
 
      nvar   , nscal  , nphas  ,                                     &
2271
 
      ncepdc(iphas) , ncetsm(iphas) ,                                &
2272
 
      nideve , nrdeve , nituse , nrtuse , iphas  ,                   &
2273
 
      ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
2274
 
      ipnfac , nodfac , ipnfbr , nodfbr ,                            &
2275
 
      ia(iicepd(iphas)) , ia(iicesm(iphas)) , ia(iitpsm(iphas)) ,    &
2276
 
      idevel , ituser , ia     ,                                     &
2277
 
      xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
2278
 
      ra(idtr) , rtp    , rtpa   , propce , propfa , propfb ,        &
2279
 
      tslagr   ,                                                     &
2280
 
      coefa  , coefb  , ra(ickupd(iphas)) , ra(ismace(iphas)) ,      &
2281
 
      ra(is2kw(iphas)), ra(idvukw(iphas)),                           &
2282
 
      ra(iviscf) , ra(iviscb) ,                                      &
2283
 
      ra(idam  ) , ra(ixam  ) ,                                      &
2284
 
      ra(idrtp ) , ra(ismbr ) , ra(irovsd) , ra(itinsk) , ra(itinse),&
2285
 
      ra(idivu ) , ra(iw1   ) , ra(iw2   ) , ra(iw3   ) , ra(iw4   ),&
2286
 
      ra(iw5   ) , ra(iw6   ) , ra(iw7   ) , ra(iw8   ) , ra(iw9   ),&
2287
 
      rdevel , rtuser , ra     )
2288
 
 
2289
 
      !  RELAXATION DE K ET OMEGA SI IKECOU=0
2290
 
      if (ikecou(iphas).eq.0 .and. idtvar.ge.0) then
2291
 
        ikiph   = ik  (iphas)
2292
 
        iomiph  = iomg(iphas)
2293
 
        relaxk = relaxv(ikiph )
2294
 
        relaxw = relaxv(iomiph)
2295
 
        do iel = 1,ncel
2296
 
          rtp(iel,ikiph)  = relaxk*rtp(iel,ikiph) +(1.d0-relaxk)*rtpa(iel,ikiph)
2297
 
          rtp(iel,iomiph) = relaxw*rtp(iel,iomiph)+(1.d0-relaxw)*rtpa(iel,iomiph)
2298
 
        enddo
2299
 
      endif
2300
 
 
2301
 
    endif
2302
 
 
2303
 
  enddo
 
1410
  ! Si on est en v2f (phi-fbar ou BL-v2/k), on reserve un tableau
 
1411
  ! de taille NCELET pour eviter de recalculer la production dans RESV2F
 
1412
  ! (trois appels a GRDCEL)
 
1413
  if (itytur.eq.5) then
 
1414
    allocate(prdv2f(ncelet))
 
1415
  endif
 
1416
 
 
1417
  if( (itytur.eq.2) .or. (itytur.eq.5) ) then
 
1418
 
 
1419
    call turbke &
 
1420
    !==========
 
1421
  ( nvar   , nscal  ,                                              &
 
1422
    ncepdc , ncetsm ,                                              &
 
1423
    icepdc , icetsm , itypsm ,                                     &
 
1424
    dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
 
1425
    tslagr ,                                                       &
 
1426
    coefa  , coefb  , ckupdc , smacel ,                            &
 
1427
    prdv2f )
 
1428
 
 
1429
    if( itytur.eq.5 )  then
 
1430
 
 
1431
      call resv2f &
 
1432
      !==========
 
1433
    ( nvar   , nscal  ,                                              &
 
1434
      ncepdc , ncetsm ,                                              &
 
1435
      icepdc , icetsm , itypsm ,                                     &
 
1436
      dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
 
1437
      coefa  , coefb  , ckupdc , smacel ,                            &
 
1438
      prdv2f )
 
1439
 
 
1440
      ! Free memory
 
1441
      deallocate(prdv2f)
 
1442
 
 
1443
    endif
 
1444
 
 
1445
    !  RELAXATION DE K ET EPSILON SI IKECOU=0 EN INSTATIONNAIRE
 
1446
    if (ikecou.eq.0 .and. idtvar.ge.0) then
 
1447
      relaxk = relaxv(ik)
 
1448
      relaxe = relaxv(iep)
 
1449
      do iel = 1,ncel
 
1450
        rtp(iel,ik) = relaxk*rtp(iel,ik) + (1.d0-relaxk)*rtpa(iel,ik)
 
1451
        rtp(iel,iep) = relaxe*rtp(iel,iep) + (1.d0-relaxe)*rtpa(iel,iep)
 
1452
      enddo
 
1453
    endif
 
1454
 
 
1455
  else if(itytur.eq.3) then
 
1456
 
 
1457
    call turrij &
 
1458
    !==========
 
1459
  ( nvar   , nscal  ,                                              &
 
1460
    ncepdc , ncetsm ,                                              &
 
1461
    icepdc , icetsm , itypsm ,                                     &
 
1462
    dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
 
1463
    tslagr ,                                                       &
 
1464
    coefa  , coefb  , ckupdc , smacel )
 
1465
 
 
1466
  else if( iturb.eq.60 ) then
 
1467
 
 
1468
    call turbkw &
 
1469
    !==========
 
1470
  ( nvar   , nscal  ,                                              &
 
1471
    ncepdc , ncetsm ,                                              &
 
1472
    icepdc , icetsm , itypsm ,                                     &
 
1473
    dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
 
1474
    tslagr ,                                                       &
 
1475
    coefa  , coefb  , ckupdc , smacel )
 
1476
 
 
1477
    !  RELAXATION DE K ET OMEGA SI IKECOU=0
 
1478
    if (ikecou.eq.0 .and. idtvar.ge.0) then
 
1479
      relaxk = relaxv(ik )
 
1480
      relaxw = relaxv(iomg)
 
1481
      do iel = 1,ncel
 
1482
        rtp(iel,ik)  = relaxk*rtp(iel,ik) +(1.d0-relaxk)*rtpa(iel,ik)
 
1483
        rtp(iel,iomg) = relaxw*rtp(iel,iomg)+(1.d0-relaxw)*rtpa(iel,iomg)
 
1484
      enddo
 
1485
    endif
 
1486
 
 
1487
  else if( iturb.eq.70 ) then
 
1488
 
 
1489
    call turbsa &
 
1490
    !==========
 
1491
  ( nvar   , nscal  ,                                              &
 
1492
    ncepdc , ncetsm ,                                              &
 
1493
    icepdc , icetsm , itypsm ,                                     &
 
1494
    dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
 
1495
    tslagr   ,                                                     &
 
1496
    coefa  , coefb  , ckupdc , smacel ,                            &
 
1497
    itypfb )
 
1498
 
 
1499
    !  RELAXATION DE NUSA
 
1500
    if (idtvar.ge.0) then
 
1501
      relaxn = relaxv(inusa)
 
1502
      do iel = 1,ncel
 
1503
        rtp(iel,inusa) = relaxn*rtp(iel,inusa)+(1.d0-relaxn)*rtpa(iel,inusa)
 
1504
      enddo
 
1505
    endif
 
1506
 
 
1507
  endif
2304
1508
 
2305
1509
endif  ! Fin si calcul sur champ de vitesse fige SUITE
2306
1510
 
2314
1518
 
2315
1519
if (nscal.ge.1 .and. iirayo.gt.0) then
2316
1520
 
2317
 
  if(iwarni(iu(1)).ge.1 .and. mod(ntcabs,nfreqr).eq.0) then
 
1521
  if(iwarni(iu).ge.1 .and. mod(ntcabs,nfreqr).eq.0) then
2318
1522
    write(nfecra,1070)
2319
1523
  endif
2320
1524
 
2321
 
  call memra2                                                     &
2322
 
  !==========
2323
 
 ( idebia , idebra ,                                              &
2324
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
2325
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
2326
 
   nvar   , nscal  , nphas  ,                                     &
2327
 
   nideve , nrdeve , nituse , nrtuse ,                            &
2328
 
   idtr   , iviscf , iviscb , idam   , ixam   ,                   &
2329
 
   idrtp  , ismbr  , irovsd ,                                     &
2330
 
 
2331
 
   icorua , icorub , iflxma , iflxmb , itek   ,                   &
2332
 
 
2333
 
   iw1    , iw2    , iw3    , iw4    , iw5    , iw6    , iw7    , &
2334
 
   iw8    , iw9    , iw10   ,                                     &
2335
 
   ifinia , ifinra )
2336
 
 
2337
 
 
2338
1525
  call raydom                                                     &
2339
1526
  !==========
2340
 
 ( ifinia , ifinra ,                                              &
2341
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
2342
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
2343
 
   nvar   , nscal  , nphas  ,                                     &
2344
 
   nideve , nrdeve , nituse , nrtuse ,                            &
2345
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml , ia(iitypf) ,      &
2346
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
2347
 
   ia(iizfrd) ,                                                   &
2348
 
   idevel , ituser , ia     ,                                     &
2349
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
1527
 ( nvar   , nscal  ,                                              &
 
1528
   itypfb ,                                                       &
 
1529
   izfrad ,                                                       &
2350
1530
   dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
2351
 
   coefa  , coefb  ,                                              &
2352
 
   ra(icorua) , ra(icorub) ,                                      &
2353
 
   ra(iflxma) , ra(iflxmb) ,                                      &
2354
 
   ra(idtr)   , ra(iviscf) , ra(iviscb) ,                         &
2355
 
   ra(idam  ) , ra(ixam  ) ,                                      &
2356
 
                ra(idrtp ) , ra(ismbr ) , ra(irovsd) , ra(itek)  ,&
2357
 
   ra(iw1   ) , ra(iw2   ) , ra(iw3   ) , ra(iw4   ) , ra(iw5   ),&
2358
 
   ra(iw6   ) , ra(iw7   ) , ra(iw8   ) , ra(iw9   ) ,            &
2359
 
   ra(iw10  ) ,                                                   &
2360
 
   rdevel , rtuser ,                                              &
2361
 
   ra     )
 
1531
   coefa  , coefb  )
2362
1532
 
2363
1533
endif
2364
1534
 
2365
1535
 
2366
1536
if (nscal.ge.1) then
2367
1537
 
2368
 
  if(iwarni(iu(1)).ge.1) then
 
1538
  if(iwarni(iu).ge.1) then
2369
1539
    write(nfecra,1060)
2370
1540
  endif
2371
1541
 
2372
 
  call memsca                                                     &
2373
 
  !==========
2374
 
 ( idebia , idebra ,                                              &
2375
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
2376
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
2377
 
   nvar   , nscal  , nphas  ,                                     &
2378
 
   nideve , nrdeve , nituse , nrtuse ,                            &
2379
 
   idtr   , iviscf , iviscb , idam   , ixam   ,                   &
2380
 
   idrtp  , ismbr  , irovsd ,                                     &
2381
 
   iw1    , iw2    , iw3    , iw4    , iw5    , iw6    , iw7    , &
2382
 
   iw8    , iw9    ,                                              &
2383
 
   ifinia , ifinra )
2384
 
 
2385
1542
  call scalai                                                     &
2386
1543
  !==========
2387
 
 ( ifinia , ifinra ,                                              &
2388
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
2389
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
2390
 
   nvar   , nscal  , nphas  ,                                     &
2391
 
   nideve , nrdeve , nituse , nrtuse ,                            &
2392
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
2393
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
2394
 
   idevel , ituser , ia     ,                                     &
2395
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
1544
 ( nvar   , nscal  ,                                              &
2396
1545
   dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
2397
 
   tslagr , coefa  , coefb  ,                                     &
2398
 
   ra(idtr)   , ra(iviscf) , ra(iviscb) ,                         &
2399
 
   ra(idam  ) , ra(ixam  ) ,                                      &
2400
 
                ra(idrtp ) , ra(ismbr ) , ra(irovsd) ,            &
2401
 
   ra(iw1   ) , ra(iw2   ) , ra(iw3   ) , ra(iw4   ) , ra(iw5   ),&
2402
 
   ra(iw6   ) , ra(iw7   ) , ra(iw8   ) , ra(iw9   ) ,            &
2403
 
   rdevel     , rtuser ,                                          &
2404
 
   ra     )
 
1546
   tslagr , coefa  , coefb  )
2405
1547
 
2406
1548
endif
2407
1549
 
2415
1557
iappel = 5
2416
1558
call schtmp                                                       &
2417
1559
!==========
2418
 
 ( idebia , idebra ,                                              &
2419
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
2420
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
2421
 
   nvar   , nscal  , nphas  , iappel ,                            &
2422
 
   nideve , nrdeve , nituse , nrtuse ,                            &
2423
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
2424
 
   ipnfac , nodfac , ipnfbr , nodfbr , isostd ,                   &
2425
 
   idevel , ituser , ia     ,                                     &
2426
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
1560
 ( nvar   , nscal  , iappel ,                                     &
 
1561
   isostd ,                                                       &
2427
1562
   dt     , rtpa   , rtp    , propce , propfa , propfb ,          &
2428
 
   coefa  , coefb  ,                                              &
2429
 
   rdevel , rtuser ,                                              &
2430
 
   ra     )
 
1563
   coefa  , coefb  )
2431
1564
 
2432
1565
!===============================================================================
2433
1566
! 18.  SORTIE DANS LE CAS DE "zero pas de temps" ET INIT ALE