← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/base/memtri.f90

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

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/base/memtri.f90
1
1
!-------------------------------------------------------------------------------
2
2
 
3
 
!     This file is part of the Code_Saturne Kernel, element of the
4
 
!     Code_Saturne CFD tool.
5
 
 
6
 
!     Copyright (C) 1998-2009 EDF S.A., France
7
 
 
8
 
!     contact: saturne-support@edf.fr
9
 
 
10
 
!     The Code_Saturne Kernel is free software; you can redistribute it
11
 
!     and/or modify it under the terms of the GNU General Public License
12
 
!     as published by the Free Software Foundation; either version 2 of
13
 
!     the License, or (at your option) any later version.
14
 
 
15
 
!     The Code_Saturne Kernel is distributed in the hope that it will be
16
 
!     useful, but WITHOUT ANY WARRANTY; without even the implied warranty
17
 
!     of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18
 
!     GNU General Public License for more details.
19
 
 
20
 
!     You should have received a copy of the GNU General Public License
21
 
!     along with the Code_Saturne Kernel; if not, write to the
22
 
!     Free Software Foundation, Inc.,
23
 
!     51 Franklin St, Fifth Floor,
24
 
!     Boston, MA  02110-1301  USA
 
3
! This file is part of Code_Saturne, a general-purpose CFD tool.
 
4
!
 
5
! Copyright (C) 1998-2011 EDF S.A.
 
6
!
 
7
! This program is free software; you can redistribute it and/or modify it under
 
8
! the terms of the GNU General Public License as published by the Free Software
 
9
! Foundation; either version 2 of the License, or (at your option) any later
 
10
! version.
 
11
!
 
12
! This program is distributed in the hope that it will be useful, but WITHOUT
 
13
! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
 
14
! FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
 
15
! details.
 
16
!
 
17
! You should have received a copy of the GNU General Public License along with
 
18
! this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
 
19
! Street, Fifth Floor, Boston, MA 02110-1301, USA.
25
20
 
26
21
!-------------------------------------------------------------------------------
27
22
 
28
23
subroutine memtri &
29
24
!================
30
25
 
31
 
 ( idbia0 , idbra0 , iverif ,                                     &
32
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
33
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
34
 
   nvar   , nscal  , nphas  ,                                     &
35
 
   ncofab , nproce , nprofa , nprofb ,                            &
36
 
   nideve , nrdeve , nituse , nrtuse ,                            &
37
 
   iisstd , ifrcx  ,                                              &
38
 
   idt    , irtp   , irtpa  , ipropc , ipropf , ipropb ,          &
39
 
   icoefa , icoefb ,                                              &
40
 
   ifinia , ifinra )
 
26
 ( idebra ,                                                       &
 
27
   nvar   , nscal  ,                                              &
 
28
   nproce ,                                                       &
 
29
   idt    , itpuco , irtp   , irtpa  , ipropc ,                   &
 
30
   ifinra )
41
31
 
42
32
!===============================================================================
43
33
!  FONCTION
50
40
!__________________.____._____.________________________________________________.
51
41
! name             !type!mode ! role                                           !
52
42
!__________________!____!_____!________________________________________________!
53
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
54
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
55
 
! iverif           ! e  ! <-- ! indicateur des tests elementaires              !
56
 
! ndim             ! i  ! <-- ! spatial dimension                              !
57
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
58
 
! ncel             ! i  ! <-- ! number of cells                                !
59
 
! nfac             ! i  ! <-- ! number of interior faces                       !
60
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
61
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
62
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
63
 
! nnod             ! i  ! <-- ! number of vertices                             !
64
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
65
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
66
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
67
43
! nvar             ! i  ! <-- ! total number of variables                      !
68
44
! nscal            ! i  ! <-- ! total number of scalars                        !
69
 
! nphas            ! i  ! <-- ! number of phases                               !
70
 
! ncofab           ! e  ! <-- ! nombre de couple de cl a prevoir               !
71
45
! nproce           ! e  ! <-- ! nombre de prop phy aux centres                 !
72
 
! nprofa           ! e  ! <-- ! nombre de prop phy aux faces internes          !
73
 
! nprofb           ! e  ! <-- ! nombre de prop phy aux faces de bord           !
74
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
75
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
76
 
! iisstd           ! e  ! --> ! "pointeur" sur isostd(reperage sortie          !
77
46
! idt              ! e  ! --> ! "pointeur" sur dt                              !
 
47
! itpuco           ! e  ! --> ! "pointeur" sur tpucou                          !
78
48
! irtp, irtpa      ! e  ! --> ! "pointeur" sur rtp, rtpa                       !
79
49
! ipropc           ! e  ! --> ! "pointeur" sur propce                          !
80
 
! ipropf           ! e  ! --> ! "pointeur" sur propfa                          !
81
 
! ipropb           ! e  ! --> ! "pointeur" sur propfb                          !
82
 
! icoefa, b        ! e  ! --> ! "pointeur" sur coefa, coefb                    !
83
 
! ifrcx            ! e  ! --> ! "pointeur" sur frcxt                           !
84
 
! ifinia           ! i  ! --> ! number of first free position in ia (at exit)  !
85
 
! ifinra           ! i  ! --> ! number of first free position in ra (at exit)  !
86
50
!__________________.____._____.________________________________________________.
87
51
 
88
52
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
91
55
!            --- tableau de travail
92
56
!===============================================================================
93
57
 
 
58
!===============================================================================
 
59
! Module files
 
60
!===============================================================================
 
61
 
 
62
use paramx
 
63
use dimens, only: ndimfb
 
64
use optcal
 
65
use cstphy
 
66
use numvar
 
67
use entsor
 
68
use pointe
 
69
use albase
 
70
use period
 
71
use ppppar
 
72
use ppthch
 
73
use ppincl
 
74
use cfpoin
 
75
use lagpar
 
76
use lagdim
 
77
use lagran
 
78
use ihmpre
 
79
use cplsat
 
80
use mesh
 
81
 
 
82
!===============================================================================
 
83
 
94
84
implicit none
95
85
 
96
 
!===============================================================================
97
 
! Common blocks
98
 
!===============================================================================
99
 
 
100
 
include "dimfbr.h"
101
 
include "paramx.h"
102
 
include "optcal.h"
103
 
include "cstphy.h"
104
 
include "numvar.h"
105
 
include "entsor.h"
106
 
include "pointe.h"
107
 
include "albase.h"
108
 
include "period.h"
109
 
include "ppppar.h"
110
 
include "ppthch.h"
111
 
include "ppincl.h"
112
 
include "cfpoin.h"
113
 
include "lagpar.h"
114
 
include "lagdim.h"
115
 
include "lagran.h"
116
 
include "ihmpre.h"
117
 
include "cplsat.h"
118
 
 
119
 
!===============================================================================
120
 
 
121
86
! Arguments
122
87
 
123
 
integer          idbia0 , idbra0
124
 
integer          iverif
125
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
126
 
integer          nfml   , nprfml
127
 
integer          nnod   , lndfac , lndfbr , ncelbr
128
 
integer          nvar   , nscal  , nphas
129
 
integer          ncofab , nproce , nprofa , nprofb
130
 
integer          nideve , nrdeve , nituse , nrtuse
131
 
integer          iisstd , ifrcx
132
 
integer          idt
 
88
integer          idebra
 
89
integer          nvar   , nscal
 
90
integer          nproce
 
91
integer          idt    , itpuco
133
92
integer          irtp   , irtpa
134
 
integer          ipropc , ipropf , ipropb
135
 
integer          icoefa , icoefb
136
 
integer          ifinia , ifinra
 
93
integer          ipropc
 
94
integer          ifinra
137
95
 
138
96
! Local variables
139
97
 
140
 
integer          idebia , idebra
141
 
integer          iis, iphas, ippu, ippv, ippw, ivar, iprop
142
 
integer          iipero , iiirij , imom, idtnm
143
 
integer          idpar1 , idpar2 , iypar1, iiyplb, iiforb, iicoci
 
98
integer          iis, ippu, ippv, ippw, ivar, iprop
 
99
integer          imom, idtnm
 
100
integer          iipuco
144
101
 
145
102
!===============================================================================
146
103
 
150
107
!===============================================================================
151
108
 
152
109
 
153
 
idebia = idbia0
154
 
idebra = idbra0
155
 
 
156
 
 
157
 
 
158
 
 
159
 
 
160
 
!===============================================================================
161
 
! 2. PLACE MEMOIRE RESERVEE AVEC DEFINITION DE IFINIA IFINRA
162
 
!===============================================================================
163
 
 
164
 
! --> Remarques :
165
 
 
166
 
!     IPUCOU = 1 ne depend pas de la phase
167
 
 
168
 
!     NCOFAB, NPROCE, NPROFA et NPROFB ont ete determines dans VARPOS
169
 
!         et ne servent en tant que dimensions que dans le present
170
 
!         sous programme. On pourrait les passer en common dans numvar.h
171
 
 
172
 
!     ITYPFB, ITRIFB et ISYMPA peuvent passer en entier dans certains
173
 
!         sous-pgm, il convient donc qu'ils soient en un seul bloc.
174
 
!         Le meilleur moyen de s'en assurer est de referencer ce bloc par un
175
 
!         pointeur unique independant de iphas.
176
 
 
177
 
!     Le tableau des zones frontieres des faces de bord pour les
178
 
!         physiques particulieres est de declare ci-dessous (voir PPCLIM)
179
 
 
180
 
 
181
 
! --> Preparations :
182
 
 
183
 
!     On regarde s'il existe au moins une periodicite de rotation
184
 
!                                 une phase avec Rij
185
 
 
186
 
iipero = 0
187
 
if (iperot.gt.0) then
188
 
  iipero = 1
189
 
endif
190
 
iiirij = 0
191
 
do iphas = 1, nphas
192
 
  if(itytur(iphas).eq.3) then
193
 
    iiirij = 1
194
 
  endif
195
 
enddo
196
 
 
197
 
 
198
 
!     Distance a la paroi
199
 
 
200
 
!       On reserve ici idipar (distance a la paroi) : c'est oblige
201
 
!       On reserve aussi iyppar (yplus) : on pourrait s'en passer
202
 
!         et en faire un tableau local a reserver dans memdyp
203
 
!         mais ca facilite la visualisation et l'initialisation
204
 
!         de yplus pour son calcul a tous les pas de temps
205
 
 
206
 
!     Distance a la paroi, tableau selon le mode de calcul
207
 
idpar1 = 0
208
 
idpar2 = 0
209
 
!     Calcul par eq de diffusion
210
 
if(ineedy.eq.1.and.abs(icdpar).eq.1) then
211
 
  idpar1 = 1
212
 
endif
213
 
!     Calcul direct
214
 
if(ineedy.eq.1.and.abs(icdpar).eq.2) then
215
 
  idpar2 = 1
216
 
endif
217
 
!     Yplus associe (calcul par mode de diffusion et LES+VanDriest
218
 
!       ou lagrangien+IROULE=2)
219
 
iypar1 = 0
220
 
if(ineedy.eq.1.and.abs(icdpar).eq.1) then
221
 
  do iphas = 1, nphas
222
 
    if(itytur(iphas).eq.4) then
223
 
      if(idries(iphas).eq.1) then
224
 
        iypar1 = 1
225
 
      endif
226
 
    endif
227
 
  enddo
228
 
  if (iilagr.ge.1 .and. iroule.eq.2) iypar1 = 1
229
 
endif
230
 
 
231
 
!     Stockage suppl�mentaire si on initialise le gradient
232
 
!       par moindre carre
233
 
 
234
 
iicoci = 0
235
 
if(imrgra.eq.4 .or. iverif.eq.1) then
236
 
  iicoci = 1
237
 
endif
238
 
 
239
 
 
240
 
!     Post-traitements particuliers  (faces de bord)
241
 
 
242
 
 
243
 
iiyplb = 0
244
 
!     Yplus au bord
245
 
if(mod(ipstdv,ipstyp).eq.0) then
246
 
  iiyplb = 1
247
 
endif
248
 
!     Efforts aux bords
249
 
iiforb = 0
250
 
if(ineedf.eq.1) then
251
 
  iiforb = 1
252
 
endif
253
 
 
254
 
 
255
 
! --> Reservation de memoire entiere
256
 
 
257
 
 
258
 
iitypf = idebia
259
 
iitrif = iitypf + nfabor *nphas
260
 
iisymp = iitrif + nfabor *nphas
261
 
ifinia = iisymp + nfabor *nphas
262
 
do iphas = 1, nphas
263
 
  if(idpar2.eq.1) then
264
 
    iifapa(iphas) = ifinia
265
 
    ifinia        = iifapa(iphas) + ncelet
266
 
  else
267
 
!         cette valeur nulle est utilisee dans les tests
268
 
    iifapa(iphas) = 0
269
 
  endif
270
 
enddo
271
 
 
272
 
!  Zones de face de bord : on utilise provisoirement les zones des physiques
273
 
!    particulieres, meme sans physique particuliere
274
 
!    -> sera modifie lors de la restructuration des zones de bord
275
 
iizfpp = ifinia
276
 
if(ippmod(iphpar).ge.1 .or. iihmpr.eq.1) then
277
 
  ifinia = iizfpp + nfabor
278
 
else
279
 
  ifinia = iizfpp
280
 
endif
281
 
 
282
 
iisstd = ifinia
283
 
ifinia = iisstd + (nfabor+1)*nphas*iphydr
284
 
 
285
 
if(ippmod(icompf).ge.0) then
286
 
  iifbet = ifinia
287
 
  iifbru = iifbet + nfabor*nphas
288
 
  ifinia = iifbru + nfabor*nphas
289
 
else
290
 
  iifbet = 0
291
 
  iifbru = 0
292
 
endif
293
 
 
294
 
! --> Reservation de memoire reelle
295
 
 
296
 
icoefa = idebra
297
 
icoefb = icoefa + ndimfb *ncofab
298
 
irtp   = icoefb + ndimfb *ncofab
 
110
!===============================================================================
 
111
! 2. PLACE MEMOIRE RESERVEE AVEC DEFINITION DE IFINRA
 
112
!===============================================================================
 
113
 
 
114
! Work arrays "tpucou"
 
115
iipuco = 0
 
116
if (ipucou.eq.1 .or. ncpdct.gt.0) then
 
117
  iipuco = 1
 
118
endif
 
119
 
 
120
! Allocate main real arrays
 
121
irtp   = idebra
299
122
irtpa  = irtp   + ncelet *nvar
300
123
ipropc = irtpa  + ncelet *nvar
301
 
ipropf = ipropc + ncelet *nproce
302
 
ipropb = ipropf + nfac   *nprofa
303
 
idt    = ipropb + ndimfb *nprofb
304
 
icocg  = idt    + ncelet
305
 
icocgb = icocg  + ncelet *9
306
 
icoci  = icocgb + ncelbr *9
307
 
icocib = icoci  + ncelet *9 * iicoci
308
 
itpuco = icocib + ncelbr *9 * iicoci
309
 
idipar = itpuco + ncelet *ndim*ipucou
310
 
iyppar = idipar + ncelet *idpar1
311
 
idudxy = iyppar + ncelet *iypar1
312
 
iwdudx = idudxy + (ncelet-ncel) * 3 * 3 * nphas * iipero
313
 
idrdxy = iwdudx + (ncelet-ncel) * 3 * 3 * nphas * iipero
314
 
iwdrdx = idrdxy + (ncelet-ncel) * 6 * 3 * nphas * iipero*iiirij
315
 
ifrcx  = iwdrdx + (ncelet-ncel) * 6 * 3 * nphas * iipero*iiirij
316
 
iyplbr = ifrcx  + ncelet*ndim*nphas*iphydr
317
 
iforbr = iyplbr + nfabor*nphas*iiyplb
318
 
ifinra = iforbr + nfabor*ndim*iiforb
319
 
 
320
 
!     On rajoute des tableaux pour le k-omega SST si necessaire
321
 
!     En k-omega, on a besoin de calculer 2 Sij.Sij pour etre utilise
322
 
!     dans PHYVAR et dans TURBKW. On reserve un tableau pour divU en meme temps.
323
 
!     Les pointeurs IS2KW et IDVUKW sont fonction de IPHAS
324
 
 
325
 
do iphas = 1, nphas
326
 
  is2kw(iphas)  = ifinra
327
 
  idvukw(iphas) = ifinra
328
 
  if (iturb(iphas).eq.60) then
329
 
    idvukw(iphas) = is2kw(iphas)  + ncelet
330
 
    ifinra        = idvukw(iphas) + ncelet
331
 
  endif
332
 
enddo
333
 
 
334
 
! En ALE ou maillage mobile, on reserve des tableaux supplementaires
335
 
! de position initiale
336
 
if (iale.eq.1.or.imobil.eq.1) then
337
 
  ixyzn0 = ifinra
338
 
  ifinra = ixyzn0 + ndim*nnod
339
 
else
340
 
  ixyzn0 = 0
341
 
endif
342
 
 
343
 
! En ALE, on reserve des tableaux supplementaires
344
 
! de deplacement et de type de faces de bord
345
 
if (iale.eq.1) then
346
 
  iimpal = ifinia
347
 
  iialty = iimpal + nnod
348
 
  ifinia = iialty + nfabor
349
 
 
350
 
  idepal = ifinra
351
 
  ifinra = idepal + ndim*nnod
352
 
else
353
 
  iimpal = 0
354
 
  iialty = 0
355
 
  idepal = 0
356
 
endif
357
 
 
358
 
! --> Verification
359
 
 
360
 
CALL IASIZE('MEMTRI',IFINIA)
361
 
!     ==========
362
 
 
363
 
CALL RASIZE('MEMTRI',IFINRA)
364
 
!     ==========
365
 
 
 
124
idt    = ipropc + ncelet *nproce
 
125
itpuco = idt    + ncelet
 
126
ifinra = itpuco + ncelet *ndim*iipuco
366
127
 
367
128
!===============================================================================
368
129
! 3. CORRESPONDANCE POUR POST-TRAITEMENT
377
138
 
378
139
!     IPPROC a ete complete au prealable dans VARPOS
379
140
 
380
 
do iphas = 1, nphas
381
 
 
382
 
  ivar = ipr   (iphas)
383
 
  ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
384
 
  ivar = iu    (iphas)
385
 
  ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
386
 
  ivar = iv    (iphas)
387
 
  ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
388
 
  ivar = iw    (iphas)
389
 
  ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
390
 
 
391
 
  if    (itytur(iphas).eq.2) then
392
 
    ivar = ik    (iphas)
393
 
    ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
394
 
    ivar = iep   (iphas)
395
 
    ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
396
 
  elseif(itytur(iphas).eq.3) then
397
 
    ivar = ir11  (iphas)
398
 
    ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
399
 
    ivar = ir22  (iphas)
400
 
    ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
401
 
    ivar = ir33  (iphas)
402
 
    ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
403
 
    ivar = ir12  (iphas)
404
 
    ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
405
 
    ivar = ir13  (iphas)
406
 
    ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
407
 
    ivar = ir23  (iphas)
408
 
    ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
409
 
    ivar = iep   (iphas)
410
 
    ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
411
 
  elseif(iturb(iphas).eq.50) then
412
 
    ivar = ik    (iphas)
413
 
    ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
414
 
    ivar = iep   (iphas)
415
 
    ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
416
 
    ivar = iphi  (iphas)
417
 
    ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
418
 
    ivar = ifb   (iphas)
419
 
    ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
420
 
  elseif(iturb(iphas).eq.60) then
421
 
    ivar = ik    (iphas)
422
 
    ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
423
 
    ivar = iomg  (iphas)
 
141
ivar = ipr
 
142
ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
 
143
ivar = iu
 
144
ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
 
145
ivar = iv
 
146
ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
 
147
ivar = iw
 
148
ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
 
149
 
 
150
if    (itytur.eq.2) then
 
151
  ivar = ik
 
152
  ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
 
153
  ivar = iep
 
154
  ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
 
155
elseif(itytur.eq.3) then
 
156
  ivar = ir11
 
157
  ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
 
158
  ivar = ir22
 
159
  ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
 
160
  ivar = ir33
 
161
  ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
 
162
  ivar = ir12
 
163
  ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
 
164
  ivar = ir13
 
165
  ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
 
166
  ivar = ir23
 
167
  ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
 
168
  ivar = iep
 
169
  ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
 
170
elseif(itytur.eq.5) then
 
171
  ivar = ik
 
172
  ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
 
173
  ivar = iep
 
174
  ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
 
175
  ivar = iphi
 
176
  ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
 
177
  if(iturb.eq.50) then
 
178
    ivar = ifb
 
179
    ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
 
180
  elseif(iturb.eq.51) then
 
181
    ivar = ial
424
182
    ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
425
183
  endif
426
 
 
427
 
enddo
 
184
elseif(iturb.eq.60) then
 
185
  ivar = ik
 
186
  ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
 
187
  ivar = iomg
 
188
  ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
 
189
elseif(iturb.eq.70) then
 
190
  ivar = inusa
 
191
  ipp2ra(ipprtp(ivar)) = irtp  +(ivar-1)*ncelet
 
192
endif
428
193
 
429
194
if (iale.eq.1) then
430
195
  ivar = iuma
457
222
!       Type de DT cumule et numero
458
223
  idtnm = idtmom(imom)
459
224
  if(idtnm.gt.0) then
460
 
    ippmom(ipppro(iprop)) =                                       &
461
 
         ipropc+(ipproc(icdtmo(idtnm))-1)*ncelet
 
225
    ippmom(ipppro(iprop)) = ipropc+(ipproc(icdtmo(idtnm))-1)*ncelet
462
226
  elseif(idtnm.lt.0) then
463
227
    ippmom(ipppro(iprop)) = idtnm
464
228
  endif
487
251
endif
488
252
 
489
253
!     Vecteur vitesse chrono
490
 
do iphas = 1, nphas
491
 
  ippu = ipprtp(iu(iphas))
492
 
  ippv = ipprtp(iv(iphas))
493
 
  ippw = ipprtp(iw(iphas))
494
 
  if(ichrvr(ippu).eq.1.and.ichrvr(ippv).eq.1.and.                 &
495
 
    ichrvr(ippw).eq.1) then
496
 
    ichrvr(ippv) = 0
497
 
    ichrvr(ippw) = 0
498
 
    ipp2ra(ippu) = - ipp2ra(ippu)
499
 
  endif
500
 
enddo
 
254
ippu = ipprtp(iu)
 
255
ippv = ipprtp(iv)
 
256
ippw = ipprtp(iw)
 
257
if(ichrvr(ippu).eq.1.and.ichrvr(ippv).eq.1.and.                 &
 
258
     ichrvr(ippw).eq.1) then
 
259
  ichrvr(ippv) = 0
 
260
  ichrvr(ippw) = 0
 
261
  ipp2ra(ippu) = - ipp2ra(ippu)
 
262
endif
501
263
!     Vecteur vitesse de maillage chrono
502
264
if (iale.eq.1) then
503
265
  ippu = ipprtp(iuma)
504
266
  ippv = ipprtp(ivma)
505
267
  ippw = ipprtp(iwma)
506
 
  if(ichrvr(ippu).eq.1.and.ichrvr(ippv).eq.1.and.                 &
507
 
    ichrvr(ippw).eq.1) then
 
268
  if(ichrvr(ippu).eq.1.and.ichrvr(ippv).eq.1.and.ichrvr(ippw).eq.1) then
508
269
    ichrvr(ippv) = 0
509
270
    ichrvr(ippw) = 0
510
271
    ipp2ra(ippu) = - ipp2ra(ippu)
515
276
  ippu = ipprtp(isca(ipotva(1)))
516
277
  ippv = ipprtp(isca(ipotva(2)))
517
278
  ippw = ipprtp(isca(ipotva(3)))
518
 
  if(ichrvr(ippu).eq.1.and.ichrvr(ippv).eq.1.and.                 &
519
 
                           ichrvr(ippw).eq.1) then
 
279
  if(ichrvr(ippu).eq.1.and.ichrvr(ippv).eq.1.and.ichrvr(ippw).eq.1) then
520
280
    ichrvr(ippv) = 0
521
281
    ichrvr(ippw) = 0
522
282
    ipp2ra(ippu) = - ipp2ra(ippu)
527
287
  ippu = ipppro(ipproc(ilapla(1)))
528
288
  ippv = ipppro(ipproc(ilapla(2)))
529
289
  ippw = ipppro(ipproc(ilapla(3)))
530
 
  if(ichrvr(ippu).eq.1.and.ichrvr(ippv).eq.1.and.                 &
531
 
                           ichrvr(ippw).eq.1) then
 
290
  if(ichrvr(ippu).eq.1.and.ichrvr(ippv).eq.1.and.ichrvr(ippw).eq.1) then
532
291
    ichrvr(ippv) = 0
533
292
    ichrvr(ippw) = 0
534
293
    ipp2ra(ippu) = - ipp2ra(ippu)