← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/base/typecl.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/typecl.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 typecl &
29
24
!================
30
25
 
31
 
 ( idbia0 , idbra0 ,                                              &
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 ,                            &
 
26
 ( nvar   , nscal  ,                                              &
38
27
   itypfb , itrifb , icodcl , isostd ,                            &
39
 
   idevel , ituser , ia     ,                                     &
40
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
41
28
   dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
42
 
   coefa  , coefb  , rcodcl , frcxt  ,                            &
43
 
   w1     , w2     , w3     , w4     , w5     , w6     , coefu  , &
44
 
   rdevel , rtuser , ra     )
 
29
   coefa  , coefb  , rcodcl , frcxt  )
45
30
 
46
31
!===============================================================================
47
32
! Function :
54
39
!__________________.____._____.________________________________________________.
55
40
! name             !type!mode ! role                                           !
56
41
!__________________!____!_____!________________________________________________!
57
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
58
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
59
 
! ndim             ! i  ! <-- ! spatial dimension                              !
60
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
61
 
! ncel             ! i  ! <-- ! number of cells                                !
62
 
! nfac             ! i  ! <-- ! number of interior faces                       !
63
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
64
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
65
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
66
 
! nnod             ! i  ! <-- ! number of vertices                             !
67
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
68
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
69
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
70
42
! nvar             ! i  ! <-- ! total number of variables                      !
71
43
! nscal            ! i  ! <-- ! total number of scalars                        !
72
 
! nphas            ! i  ! <-- ! number of phases                               !
73
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
74
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
75
 
! ifacel(2, nfac)  ! ia ! <-- ! interior faces -> cells connectivity           !
76
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
77
 
! ifmfbr(nfabor)   ! ia ! <-- ! boundary face family numbers                   !
78
 
! ifmcel(ncelet)   ! ia ! <-- ! cell family numbers                            !
79
 
! iprfml           ! ia ! <-- ! property numbers per family                    !
80
 
!  (nfml, nprfml)  !    !     !                                                !
81
 
! ipnfac(nfac+1)   ! ia ! <-- ! interior faces -> vertices index (optional)    !
82
 
! nodfac(lndfac)   ! ia ! <-- ! interior faces -> vertices list (optional)     !
83
 
! ipnfbr(nfabor+1) ! ia ! <-- ! boundary faces -> vertices index (optional)    !
84
 
! nodfbr(lndfbr)   ! ia ! <-- ! boundary faces -> vertices list (optional)     !
85
 
! itypfb           ! ia ! <-- ! boundary face types                            !
86
 
!  (nfabor, nphas) !    !     !                                                !
87
 
! itrifb(nfabor    ! te ! --> ! tab d'indirection pour tri des faces           !
88
 
!  nphas)          !    !     !                                                !
 
44
! itypfb(nfabor)   ! ia ! <-- ! boundary face types                            !
 
45
! itrifb(nfabor)   ! te ! --> ! tab d'indirection pour tri des faces           !
89
46
! icodcl           ! te ! <-- ! code de condition limites aux faces            !
90
47
!  (nfabor,nvar    !    !     !  de bord                                       !
91
48
!                  !    !     ! = 1   -> dirichlet                             !
97
54
!                  !    !     !  entrante eventuelle     bloquee               !
98
55
! isostd           ! te ! --> ! indicateur de sortie standard                  !
99
56
!    (nfabor+1)    !    !     !  +numero de la face de reference               !
100
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
101
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
102
 
! ia(*)            ! ia ! --- ! main integer work array                        !
103
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
104
 
!  (ndim, ncelet)  !    !     !                                                !
105
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
106
 
!  (ndim, nfac)    !    !     !                                                !
107
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
108
 
!  (ndim, nfabor)  !    !     !                                                !
109
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
110
 
!  (ndim, nfac)    !    !     !                                                !
111
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
112
 
!  (ndim, nfabor)  !    !     !                                                !
113
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !
114
 
!  (ndim, nnod)    !    !     !                                                !
115
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !
116
57
! dt(ncelet)       ! ra ! <-- ! time step (per cell)                           !
117
58
! rtp, rtpa        ! ra ! <-- ! calculated variables at cell centers           !
118
59
!  (ncelet, *)     !    !     !  (at current and previous time steps)          !
133
74
!                  !    !     ! pour la pression             dt*gradp          !
134
75
!                  !    !     ! pour les scalaires                             !
135
76
!                  !    !     !        cp*(viscls+visct/sigmas)*gradt          !
136
 
! frcxt(ncelet,    ! tr ! <-- ! force exterieure generant la pression          !
137
 
!   3,nphas)       !    !     !  hydrostatique                                 !
138
 
! w1,2,3,4,5,6     ! ra ! --- ! work arrays                                    !
139
 
!  (ncelet)        !    !     !  (computation of pressure gradient)            !
140
 
! rijipb           ! tr ! --- ! tab de trav pour valeurs en iprime             !
141
 
! (nfabor,6   )    !    !     !  des rij au bord                               !
142
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
143
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
144
 
! ra(*)            ! ra ! --- ! main real work array                           !
 
77
! frcxt(ncelet,3)  ! tr ! <-- ! force exterieure generant la pression          !
 
78
!                  !    !     !  hydrostatique                                 !
145
79
!__________________!____!_____!________________________________________________!
146
80
 
147
81
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
150
84
!            --- tableau de travail
151
85
!===============================================================================
152
86
 
 
87
!===============================================================================
 
88
! Module files
 
89
!===============================================================================
 
90
 
 
91
use paramx
 
92
use dimens, only: ndimfb
 
93
use numvar
 
94
use optcal
 
95
use cstnum
 
96
use cstphy
 
97
use entsor
 
98
use parall
 
99
use ppppar
 
100
use ppthch
 
101
use ppincl
 
102
use cplsat
 
103
use mesh
 
104
 
 
105
!===============================================================================
 
106
 
153
107
implicit none
154
108
 
155
 
!===============================================================================
156
 
! Fortran common blocks
157
 
!===============================================================================
158
 
 
159
 
include "dimfbr.h"
160
 
include "paramx.h"
161
 
include "numvar.h"
162
 
include "optcal.h"
163
 
include "cstnum.h"
164
 
include "cstphy.h"
165
 
include "entsor.h"
166
 
include "pointe.h"
167
 
include "parall.h"
168
 
include "ppppar.h"
169
 
include "ppthch.h"
170
 
include "ppincl.h"
171
 
include "cplsat.h"
172
 
 
173
 
!===============================================================================
174
 
 
175
109
! Arguments
176
110
 
177
 
integer          idbia0 , idbra0
178
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
179
 
integer          nfml   , nprfml
180
 
integer          nnod   , lndfac , lndfbr , ncelbr
181
 
integer          nvar   , nscal  , nphas
182
 
integer          nideve , nrdeve , nituse , nrtuse
 
111
integer          nvar   , nscal
183
112
 
184
 
integer          ifacel(2,nfac) , ifabor(nfabor)
185
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
186
 
integer          iprfml(nfml,nprfml)
187
 
integer          ipnfac(nfac+1), nodfac(lndfac)
188
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr)
189
113
integer          icodcl(nfabor,nvar)
190
 
integer          itypfb(nfabor,nphas) , itrifb(nfabor,nphas)
191
 
integer          isostd(nfabor+1,nphas)
192
 
integer          idevel(nideve), ituser(nituse)
193
 
integer          ia(*)
 
114
integer          itypfb(nfabor) , itrifb(nfabor)
 
115
integer          isostd(nfabor+1)
194
116
 
195
 
double precision xyzcen(ndim,ncelet)
196
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
197
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
198
 
double precision xyznod(ndim,nnod), volume(ncelet)
199
117
double precision dt(ncelet), rtp(ncelet,*), rtpa(ncelet,*)
200
118
double precision propce(ncelet,*)
201
119
double precision propfa(nfac,*), propfb(ndimfb,*)
202
120
double precision coefa(ndimfb,*), coefb(ndimfb,*)
203
121
double precision rcodcl(nfabor,nvar,3)
204
 
double precision frcxt(ncelet,3,nphas)
205
 
double precision w1(ncelet),w2(ncelet),w3(ncelet)
206
 
double precision w4(ncelet),w5(ncelet),w6(ncelet)
207
 
double precision coefu(nfabor,3)
208
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
 
122
double precision frcxt(ncelet,3)
209
123
 
210
124
! Local variables
211
125
 
212
126
character        chaine*80
213
 
integer          idebia, idebra
214
127
integer          ifac, ivar, iel
215
128
integer          iok, inc, iccocg, ideb, ifin, inb, isum, iwrnp
216
 
integer          ifrslb(nphsmx), itbslb(nphsmx)
217
 
integer          ityp, ii, jj, iphas, iwaru, iflmab
 
129
integer          ifrslb, itbslb
 
130
integer          ityp, ii, jj, iwaru, iflmab
218
131
integer          nswrgp, imligp, iwarnp
219
 
integer          ipriph, iuiph, iviph, iwiph
220
 
integer          ir11ip, ir22ip, ir33ip, ir12ip, ir13ip,ir23ip
221
 
integer          ikiph , iepiph, iphiph, ifbiph, iomgip
222
 
integer          iprnew, kphas, iii
 
132
integer          iii
223
133
integer          irangd, iclipr, iiptot
224
 
integer          itrois, ifadir, nfadir
 
134
integer          ifadir
225
135
double precision pref, epsrgp, climgp, extrap, coefup
226
136
double precision diipbx, diipby, diipbz
227
137
double precision flumbf, flumty(ntypmx)
228
 
double precision ro0iph, p0iph, pr0iph, xxp0, xyp0, xzp0
229
 
double precision xyzref(3)
 
138
double precision xxp0, xyp0, xzp0, d0, d0min
 
139
double precision xyzref(4) ! xyzref(3) + coefup for broadcast
 
140
 
 
141
double precision rvoid(1)
 
142
 
 
143
double precision, allocatable, dimension(:) :: coefu
 
144
double precision, allocatable, dimension(:,:) :: grad
230
145
 
231
146
integer          ipass
232
147
data             ipass /0/
239
154
! 1.  Initialization
240
155
!===============================================================================
241
156
 
242
 
idebia = idbia0
243
 
idebra = idbra0
 
157
! Allocate temporary arrays
 
158
allocate(coefu(nfabor))
 
159
 
 
160
! Initialize variables to avoid compiler warnings
 
161
 
 
162
pref = 0.d0
 
163
 
 
164
! Memoire
 
165
 
244
166
 
245
167
!===============================================================================
246
168
! 2.  Check consistency of types given in usclim
248
170
 
249
171
iok = 0
250
172
 
251
 
do iphas = 1, nphas
252
 
  do ifac = 1, nfabor
253
 
    ityp = itypfb(ifac,iphas)
254
 
    if(ityp.le.0.or.ityp.gt.ntypmx) then
255
 
      itypfb(ifac,iphas) = 0
256
 
      iok = iok + 1
257
 
    endif
258
 
  enddo
 
173
do ifac = 1, nfabor
 
174
  ityp = itypfb(ifac)
 
175
  if(ityp.le.0.or.ityp.gt.ntypmx) then
 
176
    itypfb(ifac) = 0
 
177
    iok = iok + 1
 
178
  endif
259
179
enddo
260
180
 
261
181
if (irangp.ge.0) call parcmx(iok)
262
182
if(iok.ne.0) then
263
 
  call bcderr(nphas, itypfb)
 
183
  call bcderr(itypfb)
264
184
endif
265
185
 
266
186
!===============================================================================
270
190
 
271
191
! Count faces of each type (temporarily in ifinty)
272
192
 
273
 
do iphas = 1, nphas
274
 
  do ii = 1, ntypmx
275
 
   ifinty(ii,iphas) = 0
276
 
 enddo
 
193
do ii = 1, ntypmx
 
194
  ifinty(ii) = 0
277
195
enddo
278
196
 
279
 
do iphas = 1, nphas
280
 
  do ifac = 1, nfabor
281
 
    ityp = itypfb(ifac,iphas)
282
 
    ifinty(ityp,iphas) = ifinty(ityp,iphas) + 1
283
 
  enddo
 
197
do ifac = 1, nfabor
 
198
  ityp = itypfb(ifac)
 
199
  ifinty(ityp) = ifinty(ityp) + 1
284
200
enddo
285
201
 
286
202
 
287
203
! Set start of each group of faces in itrifb (sorted by type): idebty
288
204
 
289
 
do iphas = 1, nphas
290
 
  do ii = 1, ntypmx
291
 
    idebty(ii,iphas) = 1
292
 
  enddo
 
205
do ii = 1, ntypmx
 
206
  idebty(ii) = 1
293
207
enddo
294
208
 
295
 
do iphas = 1, nphas
296
 
  do ii = 1, ntypmx-1
297
 
    do jj = ii+1, ntypmx
298
 
      idebty(jj,iphas) = idebty(jj,iphas) + ifinty(ii,iphas)
299
 
    enddo
 
209
do ii = 1, ntypmx-1
 
210
  do jj = ii+1, ntypmx
 
211
    idebty(jj) = idebty(jj) + ifinty(ii)
300
212
  enddo
301
213
enddo
302
214
 
303
215
! Sort faces in itrifb and use the opportunity to correctly set ifinty
304
216
 
305
 
do iphas = 1, nphas
306
 
  do ii = 1, ntypmx
307
 
    ifinty(ii,iphas) = idebty(ii,iphas)-1
308
 
  enddo
 
217
do ii = 1, ntypmx
 
218
  ifinty(ii) = idebty(ii)-1
309
219
enddo
310
220
 
311
 
do iphas = 1, nphas
312
 
  do ifac = 1, nfabor
313
 
    ityp = itypfb(ifac,iphas)
314
 
    ifin = ifinty(ityp,iphas)+1
315
 
    itrifb(ifin,iphas) = ifac
316
 
    ifinty(ityp,iphas) = ifin
317
 
  enddo
 
221
do ifac = 1, nfabor
 
222
  ityp = itypfb(ifac)
 
223
  ifin = ifinty(ityp)+1
 
224
  itrifb(ifin) = ifac
 
225
  ifinty(ityp) = ifin
318
226
enddo
319
227
 
320
228
! Basic check
321
229
 
322
230
iok = 0
323
 
do iphas = 1, nphas
324
 
  do ii = 1, ntypmx-1
325
 
    if(ifinty(ii,iphas).ge.idebty(ii+1,iphas)) then
326
 
      if (iok.eq.0) iok = ii
327
 
    endif
328
 
  enddo
329
 
  if (irangp.ge.0) call parcmx(iok)
330
 
  if (iok.gt.0) then
331
 
    ii = iok
332
 
    write(nfecra,2010) iphas
333
 
    if(ifinty(ii,iphas).ge.idebty(ii+1,iphas)) then
334
 
      write(nfecra,2020) (ifinty(jj,iphas),jj=1,ntypmx)
335
 
      write(nfecra,2030) (idebty(jj,iphas),jj=1,ntypmx)
336
 
      write(nfecra,2040) (itypfb(jj,iphas),jj=1,nfabor)
337
 
      write(nfecra,2098) ii,ifinty(ii,iphas),ii+1,idebty(ii+1,iphas)
338
 
    else
339
 
      write(nfecra,2099) ii,ii+1
340
 
    endif
341
 
    call csexit (1)
 
231
do ii = 1, ntypmx-1
 
232
  if(ifinty(ii).ge.idebty(ii+1)) then
 
233
    if (iok.eq.0) iok = ii
342
234
  endif
343
235
enddo
 
236
if (irangp.ge.0) call parcmx(iok)
 
237
if (iok.gt.0) then
 
238
  ii = iok
 
239
  if(ifinty(ii).ge.idebty(ii+1)) then
 
240
    write(nfecra,2020) (ifinty(jj),jj=1,ntypmx)
 
241
    write(nfecra,2030) (idebty(jj),jj=1,ntypmx)
 
242
    write(nfecra,2040) (itypfb(jj),jj=1,nfabor)
 
243
    write(nfecra,2098) ii,ifinty(ii),ii+1,idebty(ii+1)
 
244
  else
 
245
    write(nfecra,2099) ii,ii+1
 
246
  endif
 
247
  call csexit (1)
 
248
endif
344
249
 
345
250
iok = 0
346
 
do iphas = 1, nphas
347
 
  isum = 0
348
 
  do ii = 1, ntypmx
349
 
    isum = isum + ifinty(ii,iphas) - idebty(ii,iphas) + 1
350
 
  enddo
351
 
  if (irangp.ge.0) call parcpt (isum)
352
 
  if(isum.ne.nfbrgb) then
353
 
    write(nfecra,3099) iphas, isum, nfbrgb
354
 
    iok = iok + 1
355
 
  endif
 
251
isum = 0
 
252
do ii = 1, ntypmx
 
253
  isum = isum + ifinty(ii) - idebty(ii) + 1
356
254
enddo
 
255
if (irangp.ge.0) call parcpt (isum)
 
256
if(isum.ne.nfbrgb) then
 
257
  write(nfecra,3099) isum, nfbrgb
 
258
  iok = iok + 1
 
259
endif
357
260
if (iok.ne.0) then
358
261
  call csexit (1)
359
262
  !==========
363
266
! ---> On ecrit les types de faces avec la borne inf et sup et le nb
364
267
!       pour chaque type de face trouve (tjrs pour les types par defaut)
365
268
 
366
 
if(ipass.eq.0.or.iwarni(iu(1)).ge.2) then
 
269
if(ipass.eq.0.or.iwarni(iu).ge.2) then
367
270
 
368
271
  ipass = 1
369
272
 
370
273
  write(nfecra,6010)
371
274
 
372
 
  do iphas = 1, nphas
373
 
 
374
 
    write(nfecra,6011)iphas
375
 
 
376
 
    if ( ippmod(icompf).lt.0 ) then
377
 
 
378
 
      ii = ientre
379
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
380
 
      if (irangp.ge.0) call parcpt (inb)
381
 
#if defined(_CS_LANG_FR)
382
 
      write(nfecra,6020) 'Entree           ', ii, inb
383
 
#else
384
 
      write(nfecra,6020) 'Inlet            ', ii, inb
385
 
#endif
386
 
      ii = iparoi
387
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
388
 
      if (irangp.ge.0) call parcpt (inb)
389
 
#if defined(_CS_LANG_FR)
390
 
      write(nfecra,6020) 'Paroi lisse      ', ii, inb
391
 
#else
392
 
      write(nfecra,6020) 'Smooth wall      ', ii, inb
393
 
#endif
394
 
      ii = iparug
395
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
396
 
      if (irangp.ge.0) call parcpt (inb)
397
 
#if defined(_CS_LANG_FR)
398
 
      write(nfecra,6020) 'Paroi rugueuse   ', ii, inb
399
 
#else
400
 
      write(nfecra,6020) 'Rough wall       ', ii, inb
401
 
#endif
402
 
      ii = isymet
403
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
404
 
      if (irangp.ge.0) call parcpt (inb)
405
 
#if defined(_CS_LANG_FR)
406
 
      write(nfecra,6020) 'Symetrie         ', ii, inb
407
 
#else
408
 
      write(nfecra,6020) 'Symmetry         ', ii, inb
409
 
#endif
410
 
      ii = isolib
411
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
412
 
      if (irangp.ge.0) call parcpt (inb)
413
 
#if defined(_CS_LANG_FR)
414
 
      write(nfecra,6020) 'Sortie libre     ', ii, inb
415
 
#else
416
 
      write(nfecra,6020) 'Free outlet      ', ii, inb
417
 
#endif
418
 
 
419
 
      if (nbrcpl.ge.1) then
420
 
        ii = icscpl
421
 
        inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
422
 
        if (irangp.ge.0) call parcpt (inb)
423
 
#if defined(_CS_LANG_FR)
424
 
        write(nfecra,6020) 'Couplage sat/sat ', ii, inb
425
 
#else
426
 
        write(nfecra,6020) 'Sat/Sat coupling ', ii, inb
427
 
#endif
428
 
      endif
429
 
 
430
 
      ii = iindef
431
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
432
 
      if (irangp.ge.0) call parcpt (inb)
433
 
#if defined(_CS_LANG_FR)
434
 
      write(nfecra,6020) 'Indefini         ', ii, inb
435
 
#else
436
 
      write(nfecra,6020) 'Undefined        ', ii, inb
437
 
#endif
438
 
 
439
 
      do ii = 1, ntypmx
440
 
        if (ii.ne.ientre .and. &
441
 
            ii.ne.iparoi .and. &
442
 
            ii.ne.iparug .and. &
443
 
            ii.ne.isymet .and. &
444
 
            ii.ne.isolib .and. &
445
 
            ii.ne.icscpl .and. &
446
 
            ii.ne.iindef ) then
447
 
          inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
448
 
          if (irangp.ge.0) call parcpt (inb)
449
 
          if(inb.gt.0) then
450
 
#if defined(_CS_LANG_FR)
451
 
            write(nfecra,6020) 'Type utilisateur ', ii, inb
452
 
#else
453
 
            write(nfecra,6020) 'User type        ', ii, inb
454
 
#endif
455
 
          endif
456
 
        endif
457
 
      enddo
458
 
 
459
 
    else
460
 
 
461
 
      ii = ieqhcf
462
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
463
 
      if (irangp.ge.0) call parcpt (inb)
464
 
#if defined(_CS_LANG_FR)
465
 
      write(nfecra,6020) 'Entree sub. enth.', ii, inb
466
 
#else
467
 
      write(nfecra,6020) 'Sub. enth. inlet ', ii, inb
468
 
#endif
469
 
 
470
 
      ii = ierucf
471
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
472
 
      if (irangp.ge.0) call parcpt (inb)
473
 
#if defined(_CS_LANG_FR)
474
 
      write(nfecra,6020) 'Entree subsonique', ii, inb
475
 
#else
476
 
      write(nfecra,6020) 'Subsonic inlet   ', ii, inb
477
 
#endif
478
 
 
479
 
      ii = iesicf
480
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
481
 
      if (irangp.ge.0) call parcpt (inb)
482
 
#if defined(_CS_LANG_FR)
483
 
      write(nfecra,6020) 'Entree/Sortie imp', ii, inb
484
 
#else
485
 
      write(nfecra,6020) 'Imp inlet/outlet ', ii, inb
486
 
#endif
487
 
 
488
 
      ii = isopcf
489
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
490
 
      if (irangp.ge.0) call parcpt (inb)
491
 
#if defined(_CS_LANG_FR)
492
 
      write(nfecra,6020) 'Sortie subsonique', ii, inb
493
 
#else
494
 
      write(nfecra,6020) 'Subsonic outlet  ', ii, inb
495
 
#endif
496
 
 
497
 
      ii = isspcf
498
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
499
 
      if (irangp.ge.0) call parcpt (inb)
500
 
#if defined(_CS_LANG_FR)
501
 
      write(nfecra,6020) 'Sortie supersoniq', ii, inb
502
 
#else
503
 
      write(nfecra,6020) 'Supersonic outlet', ii, inb
504
 
#endif
505
 
 
506
 
      ii = iparoi
507
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
508
 
      if (irangp.ge.0) call parcpt (inb)
509
 
#if defined(_CS_LANG_FR)
510
 
      write(nfecra,6020) 'Paroi lisse      ', ii, inb
511
 
#else
512
 
      write(nfecra,6020) 'Smooth wall      ', ii, inb
513
 
#endif
514
 
 
515
 
      ii = iparug
516
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
517
 
      if (irangp.ge.0) call parcpt (inb)
518
 
#if defined(_CS_LANG_FR)
519
 
      write(nfecra,6020) 'Paroi rugueuse   ', ii, inb
520
 
#else
521
 
      write(nfecra,6020) 'Rough wall       ', ii, inb
522
 
#endif
523
 
 
524
 
      ii = isymet
525
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
526
 
      if (irangp.ge.0) call parcpt (inb)
527
 
#if defined(_CS_LANG_FR)
528
 
      write(nfecra,6020) 'Symetrie         ', ii, inb
529
 
#else
530
 
      write(nfecra,6020) 'Symmetry         ', ii, inb
531
 
#endif
532
 
 
533
 
      ii = iindef
534
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
535
 
      if (irangp.ge.0) call parcpt (inb)
536
 
#if defined(_CS_LANG_FR)
537
 
      write(nfecra,6020) 'Indefini         ', ii, inb
538
 
#else
539
 
      write(nfecra,6020) 'Undefined        ', ii, inb
540
 
#endif
541
 
 
542
 
      do ii = 1, ntypmx
543
 
        if (ii.ne.iesicf .and. &
544
 
            ii.ne.isspcf .and. &
545
 
            ii.ne.ieqhcf .and. &
546
 
            ii.ne.ierucf .and. &
547
 
            ii.ne.isopcf .and. &
548
 
            ii.ne.iparoi .and. &
549
 
            ii.ne.iparug .and. &
550
 
            ii.ne.isymet .and. &
551
 
            ii.ne.iindef ) then
552
 
          inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
553
 
          if (irangp.ge.0) call parcpt (inb)
554
 
          if(inb.gt.0) then
555
 
#if defined(_CS_LANG_FR)
556
 
            write(nfecra,6020) 'Type utilisateur ',ii, inb
557
 
#else
558
 
            write(nfecra,6020) 'User type        ',ii, inb
559
 
#endif
560
 
          endif
561
 
        endif
562
 
      enddo
563
 
 
 
275
  write(nfecra,6011)
 
276
 
 
277
  if ( ippmod(icompf).lt.0 ) then
 
278
 
 
279
    ii = ientre
 
280
    inb = ifinty(ii)-idebty(ii)+1
 
281
    if (irangp.ge.0) call parcpt (inb)
 
282
#if defined(_CS_LANG_FR)
 
283
    write(nfecra,6020) 'Entree           ', ii, inb
 
284
#else
 
285
    write(nfecra,6020) 'Inlet            ', ii, inb
 
286
#endif
 
287
    ii = iparoi
 
288
    inb = ifinty(ii)-idebty(ii)+1
 
289
    if (irangp.ge.0) call parcpt (inb)
 
290
#if defined(_CS_LANG_FR)
 
291
    write(nfecra,6020) 'Paroi lisse      ', ii, inb
 
292
#else
 
293
    write(nfecra,6020) 'Smooth wall      ', ii, inb
 
294
#endif
 
295
    ii = iparug
 
296
    inb = ifinty(ii)-idebty(ii)+1
 
297
    if (irangp.ge.0) call parcpt (inb)
 
298
#if defined(_CS_LANG_FR)
 
299
    write(nfecra,6020) 'Paroi rugueuse   ', ii, inb
 
300
#else
 
301
    write(nfecra,6020) 'Rough wall       ', ii, inb
 
302
#endif
 
303
    ii = isymet
 
304
    inb = ifinty(ii)-idebty(ii)+1
 
305
    if (irangp.ge.0) call parcpt (inb)
 
306
#if defined(_CS_LANG_FR)
 
307
    write(nfecra,6020) 'Symetrie         ', ii, inb
 
308
#else
 
309
    write(nfecra,6020) 'Symmetry         ', ii, inb
 
310
#endif
 
311
    ii = isolib
 
312
    inb = ifinty(ii)-idebty(ii)+1
 
313
    if (irangp.ge.0) call parcpt (inb)
 
314
#if defined(_CS_LANG_FR)
 
315
    write(nfecra,6020) 'Sortie libre     ', ii, inb
 
316
#else
 
317
    write(nfecra,6020) 'Free outlet      ', ii, inb
 
318
#endif
 
319
 
 
320
    if (nbrcpl.ge.1) then
 
321
      ii = icscpl
 
322
      inb = ifinty(ii)-idebty(ii)+1
 
323
      if (irangp.ge.0) call parcpt (inb)
 
324
#if defined(_CS_LANG_FR)
 
325
      write(nfecra,6020) 'Couplage sat/sat ', ii, inb
 
326
#else
 
327
      write(nfecra,6020) 'Sat/Sat coupling ', ii, inb
 
328
#endif
564
329
    endif
565
330
 
566
 
    write(nfecra,6030)
567
 
 
568
 
  enddo
 
331
    ii = iindef
 
332
    inb = ifinty(ii)-idebty(ii)+1
 
333
    if (irangp.ge.0) call parcpt (inb)
 
334
#if defined(_CS_LANG_FR)
 
335
    write(nfecra,6020) 'Indefini         ', ii, inb
 
336
#else
 
337
    write(nfecra,6020) 'Undefined        ', ii, inb
 
338
#endif
 
339
 
 
340
    do ii = 1, ntypmx
 
341
      if (ii.ne.ientre .and. &
 
342
           ii.ne.iparoi .and. &
 
343
           ii.ne.iparug .and. &
 
344
           ii.ne.isymet .and. &
 
345
           ii.ne.isolib .and. &
 
346
           ii.ne.icscpl .and. &
 
347
           ii.ne.iindef ) then
 
348
        inb = ifinty(ii)-idebty(ii)+1
 
349
        if (irangp.ge.0) call parcpt (inb)
 
350
        if(inb.gt.0) then
 
351
#if defined(_CS_LANG_FR)
 
352
          write(nfecra,6020) 'Type utilisateur ', ii, inb
 
353
#else
 
354
          write(nfecra,6020) 'User type        ', ii, inb
 
355
#endif
 
356
        endif
 
357
      endif
 
358
    enddo
 
359
 
 
360
  else
 
361
 
 
362
    ii = ieqhcf
 
363
    inb = ifinty(ii)-idebty(ii)+1
 
364
    if (irangp.ge.0) call parcpt (inb)
 
365
#if defined(_CS_LANG_FR)
 
366
    write(nfecra,6020) 'Entree sub. enth.', ii, inb
 
367
#else
 
368
    write(nfecra,6020) 'Sub. enth. inlet ', ii, inb
 
369
#endif
 
370
 
 
371
    ii = ierucf
 
372
    inb = ifinty(ii)-idebty(ii)+1
 
373
    if (irangp.ge.0) call parcpt (inb)
 
374
#if defined(_CS_LANG_FR)
 
375
    write(nfecra,6020) 'Entree subsonique', ii, inb
 
376
#else
 
377
    write(nfecra,6020) 'Subsonic inlet   ', ii, inb
 
378
#endif
 
379
 
 
380
    ii = iesicf
 
381
    inb = ifinty(ii)-idebty(ii)+1
 
382
    if (irangp.ge.0) call parcpt (inb)
 
383
#if defined(_CS_LANG_FR)
 
384
    write(nfecra,6020) 'Entree/Sortie imp', ii, inb
 
385
#else
 
386
    write(nfecra,6020) 'Imp inlet/outlet ', ii, inb
 
387
#endif
 
388
 
 
389
    ii = isopcf
 
390
    inb = ifinty(ii)-idebty(ii)+1
 
391
    if (irangp.ge.0) call parcpt (inb)
 
392
#if defined(_CS_LANG_FR)
 
393
    write(nfecra,6020) 'Sortie subsonique', ii, inb
 
394
#else
 
395
    write(nfecra,6020) 'Subsonic outlet  ', ii, inb
 
396
#endif
 
397
 
 
398
    ii = isspcf
 
399
    inb = ifinty(ii)-idebty(ii)+1
 
400
    if (irangp.ge.0) call parcpt (inb)
 
401
#if defined(_CS_LANG_FR)
 
402
    write(nfecra,6020) 'Sortie supersoniq', ii, inb
 
403
#else
 
404
    write(nfecra,6020) 'Supersonic outlet', ii, inb
 
405
#endif
 
406
 
 
407
    ii = iparoi
 
408
    inb = ifinty(ii)-idebty(ii)+1
 
409
    if (irangp.ge.0) call parcpt (inb)
 
410
#if defined(_CS_LANG_FR)
 
411
    write(nfecra,6020) 'Paroi lisse      ', ii, inb
 
412
#else
 
413
    write(nfecra,6020) 'Smooth wall      ', ii, inb
 
414
#endif
 
415
 
 
416
    ii = iparug
 
417
    inb = ifinty(ii)-idebty(ii)+1
 
418
    if (irangp.ge.0) call parcpt (inb)
 
419
#if defined(_CS_LANG_FR)
 
420
    write(nfecra,6020) 'Paroi rugueuse   ', ii, inb
 
421
#else
 
422
    write(nfecra,6020) 'Rough wall       ', ii, inb
 
423
#endif
 
424
 
 
425
    ii = isymet
 
426
    inb = ifinty(ii)-idebty(ii)+1
 
427
    if (irangp.ge.0) call parcpt (inb)
 
428
#if defined(_CS_LANG_FR)
 
429
    write(nfecra,6020) 'Symetrie         ', ii, inb
 
430
#else
 
431
    write(nfecra,6020) 'Symmetry         ', ii, inb
 
432
#endif
 
433
 
 
434
    ii = iindef
 
435
    inb = ifinty(ii)-idebty(ii)+1
 
436
    if (irangp.ge.0) call parcpt (inb)
 
437
#if defined(_CS_LANG_FR)
 
438
    write(nfecra,6020) 'Indefini         ', ii, inb
 
439
#else
 
440
    write(nfecra,6020) 'Undefined        ', ii, inb
 
441
#endif
 
442
 
 
443
    do ii = 1, ntypmx
 
444
      if (ii.ne.iesicf .and. &
 
445
           ii.ne.isspcf .and. &
 
446
           ii.ne.ieqhcf .and. &
 
447
           ii.ne.ierucf .and. &
 
448
           ii.ne.isopcf .and. &
 
449
           ii.ne.iparoi .and. &
 
450
           ii.ne.iparug .and. &
 
451
           ii.ne.isymet .and. &
 
452
           ii.ne.iindef ) then
 
453
        inb = ifinty(ii)-idebty(ii)+1
 
454
        if (irangp.ge.0) call parcpt (inb)
 
455
        if(inb.gt.0) then
 
456
#if defined(_CS_LANG_FR)
 
457
          write(nfecra,6020) 'Type utilisateur ',ii, inb
 
458
#else
 
459
          write(nfecra,6020) 'User type        ',ii, inb
 
460
#endif
 
461
        endif
 
462
      endif
 
463
    enddo
 
464
 
 
465
  endif
 
466
 
 
467
  write(nfecra,6030)
569
468
 
570
469
endif
571
470
 
575
474
!     isolib and ientre are handled later.
576
475
!================================================================================
577
476
 
578
 
do iphas = 1, nphas
579
 
  do ivar=1, nvar
580
 
     do ifac = 1, nfabor
581
 
        if((itypfb(ifac,iphas) .ne. isolib) .and. &
582
 
           (itypfb(ifac,iphas) .ne. ientre) .and. &
583
 
           (rcodcl(ifac,ivar,1) .gt. rinfin*0.5d0)) then
584
 
           rcodcl(ifac,ivar,1) = 0.d0
585
 
       endif
586
 
      enddo
587
 
   enddo
 
477
do ivar=1, nvar
 
478
  do ifac = 1, nfabor
 
479
    if((itypfb(ifac) .ne. isolib) .and. &
 
480
         (itypfb(ifac) .ne. ientre) .and. &
 
481
         (rcodcl(ifac,ivar,1) .gt. rinfin*0.5d0)) then
 
482
      rcodcl(ifac,ivar,1) = 0.d0
 
483
    endif
 
484
  enddo
588
485
enddo
589
486
 
590
 
 
591
487
!===============================================================================
592
 
! 5.  Compute pressure at boundary (in coefu(*,1))
 
488
! 5.  Compute pressure at boundary (in coefu(*))
593
489
!     (if we need it, that is if there are outlet boudary faces).
594
490
 
595
491
!     The loop on phases starts here and ends at the end of the next block.
596
492
!===============================================================================
597
493
 
598
 
! --- Boucle sur les phases : debut
599
 
do iphas = 1, nphas
600
 
 
601
 
  ro0iph = ro0  (iphas)
602
 
  p0iph  = p0   (iphas)
603
 
  pr0iph = pred0(iphas)
604
 
  xxp0   = xyzp0(1,iphas)
605
 
  xyp0   = xyzp0(2,iphas)
606
 
  xzp0   = xyzp0(3,iphas)
607
 
  ipriph = ipr (iphas)
608
 
  iuiph  = iu  (iphas)
609
 
  iviph  = iv  (iphas)
610
 
  iwiph  = iw  (iphas)
611
 
  if(itytur(iphas).eq.2) then
612
 
    ikiph  = ik(iphas)
613
 
    iepiph = iep(iphas)
614
 
  elseif(itytur(iphas).eq.3) then
615
 
    ir11ip = ir11(iphas)
616
 
    ir22ip = ir22(iphas)
617
 
    ir33ip = ir33(iphas)
618
 
    ir12ip = ir12(iphas)
619
 
    ir13ip = ir13(iphas)
620
 
    ir23ip = ir23(iphas)
621
 
    iepiph = iep(iphas)
622
 
  elseif(iturb(iphas).eq.50) then
623
 
    ikiph  = ik(iphas)
624
 
    iepiph = iep(iphas)
625
 
    iphiph = iphi(iphas)
626
 
    ifbiph = ifb(iphas)
627
 
  elseif(iturb(iphas).eq.60) then
628
 
    ikiph  = ik (iphas)
629
 
    iomgip = iomg(iphas)
630
 
  endif
631
 
 
632
 
! Check if the pressure (unique) has not been handled already
633
 
 
634
 
  iprnew = 1
635
 
  if(iphas.gt.1) then
636
 
    do kphas = 1, iphas-1
637
 
      if(ipr(iphas).eq.ipr(kphas)) then
638
 
        iprnew = 0
639
 
      endif
640
 
    enddo
641
 
  endif
642
 
 
643
 
! ifrslb = first free standard outlet face (icodcl not modified)
 
494
xxp0   = xyzp0(1)
 
495
xyp0   = xyzp0(2)
 
496
xzp0   = xyzp0(3)
 
497
 
 
498
! ifrslb = closest free standard outlet face to xyzp0 (icodcl not modified)
644
499
! itbslb = max of ifrslb on all ranks, standard outlet face presence indicator
645
500
 
646
 
  ifrslb(iphas) = 0
647
 
  do ii = ifinty(isolib,iphas), idebty(isolib,iphas), -1
648
 
    ifac = itrifb(ii,iphas)
649
 
    if (icodcl(ifac,ipriph).eq.0)                                 &
650
 
         ifrslb(iphas) = ifac
651
 
  enddo
652
 
  itbslb(iphas) = ifrslb(iphas)
653
 
  if (irangp.ge.0) then
654
 
     call parcmx (itbslb(iphas))
655
 
  endif
656
 
 
657
 
  if ((itbslb(iphas).gt.0) .and. (iprnew.eq.1)) then
658
 
 
659
 
    inc = 1
660
 
    iccocg = 1
661
 
    nswrgp = nswrgr(ipriph)
662
 
    imligp = imligr(ipriph)
663
 
    iwarnp = iwarni(ipriph)
664
 
    epsrgp = epsrgr(ipriph)
665
 
    climgp = climgr(ipriph)
666
 
    extrap = extrag(ipriph)
667
 
    iclipr = iclrtp(ipriph,icoef)
668
 
 
669
 
    call grdcel                                                   &
670
 
    !==========
671
 
 ( idebia , idebra ,                                              &
672
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
673
 
   nnod   , lndfac , lndfbr , ncelbr , nphas  ,                   &
674
 
   nideve , nrdeve , nituse , nrtuse ,                            &
675
 
   ipriph , imrgra , inc    , iccocg , nswrgp , imligp , iphydr , &
676
 
   iwarnp , nfecra , epsrgp , climgp , extrap ,                   &
677
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
678
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
679
 
   idevel , ituser , ia     ,                                     &
680
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
681
 
   frcxt(1,1,iphas), frcxt(1,2,iphas), frcxt(1,3,iphas),          &
682
 
   rtpa(1,ipriph)  , coefa(1,iclipr) , coefb(1,iclipr) ,          &
683
 
   w1     , w2     , w3     ,                                     &
684
 
!        ------   ------   ------
685
 
   w4     , w5     , w6     ,                                     &
686
 
   rdevel , rtuser , ra     )
687
 
 
688
 
 
689
 
!  Put in coefu the value at I' or F (depending on iphydr) of the
690
 
!  total pressure, computed from P*
691
 
 
692
 
    if (iphydr.eq.0) then
693
 
      do ifac = 1, nfabor
694
 
        ii = ifabor(ifac)
695
 
        iii = idiipb-1+3*(ifac-1)
696
 
        diipbx = ra(iii+1)
697
 
        diipby = ra(iii+2)
698
 
        diipbz = ra(iii+3)
699
 
        coefu(ifac,1) = rtpa(ii,ipriph)                           &
700
 
             + diipbx*w1(ii)+ diipby*w2(ii) + diipbz*w3(ii)       &
701
 
             + ro0iph*( gx*(cdgfbo(1,ifac)-xxp0)                  &
702
 
                      + gy*(cdgfbo(2,ifac)-xyp0)                  &
703
 
                      + gz*(cdgfbo(3,ifac)-xzp0))                 &
704
 
             + p0iph - pr0iph
705
 
      enddo
706
 
    else
707
 
      do ifac = 1, nfabor
708
 
        ii = ifabor(ifac)
709
 
        coefu(ifac,1) = rtpa(ii,ipriph)                           &
710
 
             + (cdgfbo(1,ifac)-xyzcen(1,ii))*w1(ii)               &
711
 
             + (cdgfbo(2,ifac)-xyzcen(2,ii))*w2(ii)               &
712
 
             + (cdgfbo(3,ifac)-xyzcen(3,ii))*w3(ii)               &
713
 
             + ro0iph*(  gx*(cdgfbo(1,ifac)-xxp0)                 &
714
 
                       + gy*(cdgfbo(2,ifac)-xyp0)                 &
715
 
                       + gz*(cdgfbo(3,ifac)-xzp0))                &
716
 
             + p0iph - pr0iph
717
 
      enddo
 
501
! Even when the user has not chosen xyzp0 (and it is thus at the
 
502
! origin), we choose the face whose center is closest to it, so
 
503
! as to be mesh numbering (and partitioning) independent.
 
504
 
 
505
d0min = rinfin
 
506
 
 
507
ifrslb = 0
 
508
 
 
509
ideb = idebty(isolib)
 
510
ifin = ifinty(isolib)
 
511
 
 
512
do ii = ideb, ifin
 
513
  ifac = itrifb(ii)
 
514
  if (icodcl(ifac,ipr).eq.0) then
 
515
    d0 =   (cdgfbo(1,ifac)-xxp0)**2  &
 
516
         + (cdgfbo(2,ifac)-xyp0)**2  &
 
517
         + (cdgfbo(3,ifac)-xzp0)**2
 
518
    if (d0.lt.d0min) then
 
519
      ifrslb = ifac
 
520
      d0min = d0
718
521
    endif
719
 
 
720
 
  endif
721
 
 
 
522
  endif
 
523
enddo
 
524
 
 
525
! If we have free outlet faces, irangd and itbslb will
 
526
! contain respectively the rank having the boundary face whose
 
527
! center is closest to xyzp0, and the local number of that face
 
528
! on that rank (also equal to ifrslb on that rank).
 
529
! If we do not have free outlet faces, than itbslb = 0
 
530
! (as it was initialized that way on all ranks).
 
531
 
 
532
itbslb = ifrslb
 
533
irangd = irangp
 
534
if (irangp.ge.0) then
 
535
  call parfpt(itbslb, irangd, d0min)
 
536
endif
 
537
 
 
538
if (itbslb.gt.0) then
 
539
 
 
540
  ! Allocate a work array for the gradient calculation
 
541
  allocate(grad(ncelet,3))
 
542
 
 
543
  inc = 1
 
544
  iccocg = 1
 
545
  nswrgp = nswrgr(ipr)
 
546
  imligp = imligr(ipr)
 
547
  iwarnp = iwarni(ipr)
 
548
  epsrgp = epsrgr(ipr)
 
549
  climgp = climgr(ipr)
 
550
  extrap = extrag(ipr)
 
551
  iclipr = iclrtp(ipr,icoef)
 
552
 
 
553
  call grdpot &
 
554
  !==========
 
555
     ( ipr , imrgra , inc    , iccocg , nswrgp , imligp , iphydr ,    &
 
556
       iwarnp , nfecra , epsrgp , climgp , extrap ,                   &
 
557
       rvoid  ,                                                       &
 
558
       frcxt(1,1), frcxt(1,2), frcxt(1,3),                            &
 
559
       rtpa(1,ipr)  , coefa(1,iclipr) , coefb(1,iclipr) ,             &
 
560
       grad   )
 
561
 
 
562
 
 
563
  !  Put in coefu the value at I' or F (depending on iphydr) of the
 
564
  !  total pressure, computed from P*
 
565
 
 
566
  if (iphydr.eq.0) then
 
567
    do ifac = 1, nfabor
 
568
      ii = ifabor(ifac)
 
569
      diipbx = diipb(1,ifac)
 
570
      diipby = diipb(2,ifac)
 
571
      diipbz = diipb(3,ifac)
 
572
      coefu(ifac) = rtpa(ii,ipr)                                      &
 
573
           + diipbx*grad(ii,1)+ diipby*grad(ii,2) + diipbz*grad(ii,3) &
 
574
           + ro0*( gx*(cdgfbo(1,ifac)-xxp0)                           &
 
575
           + gy*(cdgfbo(2,ifac)-xyp0)                                 &
 
576
           + gz*(cdgfbo(3,ifac)-xzp0))                                &
 
577
           + p0 - pred0
 
578
    enddo
 
579
  else
 
580
    do ifac = 1, nfabor
 
581
      ii = ifabor(ifac)
 
582
      coefu(ifac) = rtpa(ii,ipr)                                &
 
583
           + (cdgfbo(1,ifac)-xyzcen(1,ii))*grad(ii,1)           &
 
584
           + (cdgfbo(2,ifac)-xyzcen(2,ii))*grad(ii,2)           &
 
585
           + (cdgfbo(3,ifac)-xyzcen(3,ii))*grad(ii,3)           &
 
586
           + ro0*(  gx*(cdgfbo(1,ifac)-xxp0)                    &
 
587
           + gy*(cdgfbo(2,ifac)-xyp0)                           &
 
588
           + gz*(cdgfbo(3,ifac)-xzp0))                          &
 
589
           + p0 - pred0
 
590
    enddo
 
591
  endif
 
592
 
 
593
  ! Free memory
 
594
  deallocate(grad)
 
595
 
 
596
endif
722
597
 
723
598
!===============================================================================
724
599
! 6.  Convert to rcodcl and icodcl
734
609
! ---> La pression a un traitement Neumann, le reste Dirichlet
735
610
!                                           sera traite plus tard.
736
611
 
737
 
  ideb = idebty(ientre,iphas)
738
 
  ifin = ifinty(ientre,iphas)
 
612
ideb = idebty(ientre)
 
613
ifin = ifinty(ientre)
739
614
 
740
 
  do ivar = 1, nvar
741
 
    if (ivar.eq.ipriph) then
742
 
      if(iprnew.eq.1) then
743
 
        do ii = ideb, ifin
744
 
          ifac = itrifb(ii,iphas)
745
 
          if(icodcl(ifac,ivar).eq.0) then
746
 
            icodcl(ifac,ivar)   = 3
747
 
            rcodcl(ifac,ivar,1) = 0.d0
748
 
            rcodcl(ifac,ivar,2) = rinfin
749
 
            rcodcl(ifac,ivar,3) = 0.d0
750
 
          endif
751
 
        enddo
 
615
do ivar = 1, nvar
 
616
  if (ivar.eq.ipr) then
 
617
    do ii = ideb, ifin
 
618
      ifac = itrifb(ii)
 
619
      if(icodcl(ifac,ivar).eq.0) then
 
620
        icodcl(ifac,ivar)   = 3
 
621
        rcodcl(ifac,ivar,1) = 0.d0
 
622
        rcodcl(ifac,ivar,2) = rinfin
 
623
        rcodcl(ifac,ivar,3) = 0.d0
752
624
      endif
753
 
    endif
754
 
  enddo
 
625
    enddo
 
626
  endif
 
627
enddo
755
628
 
756
629
 
757
630
! 6.2 SORTIE (entr�e-sortie libre) (ISOLIB)
761
634
!        (le reste Neumann, ou Dirichlet si donn�e utilisateur,
762
635
!        sera traite plus tard)
763
636
 
764
 
  if (iphydr.eq.1) then
 
637
if (iphydr.eq.1) then
765
638
 
766
639
!     En cas de prise en compte de la pression hydrostatique,
767
640
!     on remplit le tableau ISOSTD
768
641
!     0 -> pas une face de sortie standard (i.e. pas sortie ou sortie avec CL
769
642
!                                                de pression modifiee)
770
643
!     1 -> face de sortie libre avec CL de pression automatique.
771
 
!     le numero de la face de reference est stocke dans ISOSTD(NFABOR+1,IPHAS)
 
644
!     le numero de la face de reference est stocke dans ISOSTD(NFABOR+1)
772
645
!     qui est d'abord initialise a -1 (i.e. pas de face de sortie std)
773
 
    isostd(nfabor+1,iphas) = -1
774
 
    do ifac = 1,nfabor
775
 
      isostd(ifac,iphas) = 0
776
 
      if ((itypfb(ifac,iphas).eq.isolib).and.                     &
777
 
           (icodcl(ifac,ipriph).eq.0)) then
778
 
        isostd(ifac,iphas) = 1
779
 
      endif
780
 
    enddo
781
 
  endif
782
 
 
783
 
! ---> Pression de recalage (unique, meme s'il y a plusieurs sorties)
784
 
!     En cas de prise en compte de la pression hydrostatique, on cherche
785
 
!     la face de reference
786
 
 
787
 
!   Determination de la pression P I' unique en parallele
788
 
!     S'il y a des faces de sortie libre, on cherche le premier
789
 
!     proc sur lequel il y en a.
 
646
  isostd(nfabor+1) = -1
 
647
  do ifac = 1,nfabor
 
648
    isostd(ifac) = 0
 
649
    if ((itypfb(ifac).eq.isolib).and.                     &
 
650
         (icodcl(ifac,ipr).eq.0)) then
 
651
      isostd(ifac) = 1
 
652
    endif
 
653
  enddo
 
654
endif
 
655
 
 
656
! ---> Reference pressure (unique, even if there are multiple outlets)
 
657
!     In case we account for the hydrostatic pressure, we search for the
 
658
!     reference face.
 
659
 
 
660
!   Determine a unique P I' pressure in parallel
 
661
!     if there are free outlet faces, we have determined that the rank
 
662
!     with the outlet face closest to xyzp0 is irangd.
790
663
 
791
664
!     We also retrieve the coordinates of the reference point, so as to
792
665
!     calculate pref later on.
793
666
 
794
 
  if (itbslb(iphas).gt.0) then
795
 
 
796
 
    if (irangp.ge.0) then
797
 
 
798
 
!     Indicateur de sorties locales et pointeur sur la premiere face
799
 
!       S'il y a des sorties libres standards quelque part
800
 
!         et s'il n'y en a pas en local, on affecte a IRANGD la valeur -1
801
 
      if(ifrslb(iphas).le.0) then
802
 
        irangd = -1
803
 
!         et s'il y en a en local, on affecte a IRANGD la valeur IRANGP
804
 
      else
805
 
        irangd = irangp
806
 
      endif
807
 
 
808
 
!     Valeur de P I'
809
 
!         on prend le numero du dernier proc sur lequel il y en a
810
 
      call parcmx(irangd)
811
 
!         si c'est le proc courant, on affecte P I' a COEFUP
812
 
      if (irangp.eq.irangd) then
813
 
        coefup = coefu(ifrslb(iphas),1)
814
 
        if (iphydr.eq.1) isostd(nfabor+1,iphas) = ifrslb(iphas)
815
 
!         sinon on affecte 0 a COEFUP
816
 
      else
817
 
        coefup = 0.d0
818
 
      endif
819
 
!         la somme sur les procs de COEFUP donne donc P I', disponible
820
 
!            pour tous les procs (c'est plus simple qu'un bcast pour
821
 
!            lequel il faudrait au prealable que tous les proc sachent
822
 
!            quel proc envoie).
823
 
      call parsom(coefup)
824
 
 
825
 
!     Reference de pression pour les sorties
826
 
      if (irangp.eq.irangd) then
827
 
        xyzref(1) = cdgfbo(1,ifrslb(iphas))
828
 
        xyzref(2) = cdgfbo(2,ifrslb(iphas))
829
 
        xyzref(3) = cdgfbo(3,ifrslb(iphas))
830
 
      else
831
 
        xyzref(1) = 0.d0
832
 
        xyzref(2) = 0.d0
833
 
        xyzref(3) = 0.d0
834
 
      endif
835
 
      itrois = 3
836
 
      call parrsm(itrois,xyzref)
837
 
 
838
 
!   Determination de la pression P I' unique en sequentiel
839
 
!     on repere la premiere face de sortie libre standard
840
 
!                       et on affecte PI' a COEFUP
841
 
 
842
 
    else
843
 
 
844
 
      coefup = coefu(ifrslb(iphas),1)
845
 
      if (iphydr.eq.1) isostd(nfabor+1,iphas) = ifrslb(iphas)
846
 
      xyzref(1) = cdgfbo(1,ifrslb(iphas))
847
 
      xyzref(2) = cdgfbo(2,ifrslb(iphas))
848
 
      xyzref(3) = cdgfbo(3,ifrslb(iphas))
849
 
    endif
850
 
 
851
 
!     Si l'utilisateur n'a rien specifie, on met IXYZP0 a 2 pour mettre
852
 
!     a jour le point de reference
853
 
    if (ixyzp0(iphas).eq.-1) ixyzp0(iphas) = 2
854
 
 
855
 
  elseif (ixyzp0(iphas).lt.0) then
856
 
!     S'il n'y a pas de faces de sortie, on cherche des Dirichlets
857
 
!     eventuels specifies par l'utilisateur pour y localiser
858
 
!     le point de reference.
859
 
    ifadir = -1
860
 
    irangd = -1
861
 
    do ifac = 1, nfabor
862
 
      if (icodcl(ifac,ipriph).eq.1) then
 
667
if (itbslb.gt.0) then
 
668
 
 
669
  ! If irangd is the local rank, we assign PI' to coefup
 
670
  ! (this is always the case in serial mode)
 
671
 
 
672
  if (irangp.eq.irangd) then
 
673
    xyzref(1) = cdgfbo(1,ifrslb)
 
674
    xyzref(2) = cdgfbo(2,ifrslb)
 
675
    xyzref(3) = cdgfbo(3,ifrslb)
 
676
    xyzref(4) = coefu(ifrslb) ! coefup
 
677
    if (iphydr.eq.1) isostd(nfabor+1) = ifrslb
 
678
  endif
 
679
 
 
680
  ! Broadcast coefup and pressure reference
 
681
  ! from irangd to all other ranks.
 
682
  if (irangp.ge.0) then
 
683
    inb = 4
 
684
    call parbcr(irangd, inb, xyzref)
 
685
  endif
 
686
 
 
687
  coefup = xyzref(4)
 
688
  xyzref(4) = 0.d0
 
689
 
 
690
  ! If the user has not specified anything, we set ixyzp0 to 2 so as
 
691
  ! to update the reference point.
 
692
 
 
693
  if (ixyzp0.eq.-1) ixyzp0 = 2
 
694
 
 
695
elseif (ixyzp0.lt.0) then
 
696
 
 
697
  ! If there are no outlet faces, we search for possible Dirichlets
 
698
  ! specified by the user so as to locate the reference point.
 
699
  ! As before, we chose the face closest to xyzp0 so as to
 
700
  ! be mesh numbering (and partitioning) independent.
 
701
 
 
702
  d0min = rinfin
 
703
 
 
704
  ifadir = -1
 
705
  do ifac = 1, nfabor
 
706
    if (icodcl(ifac,ipr).eq.1) then
 
707
      d0 =   (cdgfbo(1,ifac)-xxp0)**2  &
 
708
           + (cdgfbo(2,ifac)-xyp0)**2  &
 
709
           + (cdgfbo(3,ifac)-xzp0)**2
 
710
      if (d0.lt.d0min) then
863
711
        ifadir = ifac
864
 
        irangd = irangp
865
 
      endif
866
 
    enddo
867
 
    nfadir = ifadir
868
 
    if (irangp.ge.0) call parcmx(nfadir)
869
 
    if (nfadir.gt.0) then
870
 
!     on met IXYZP0 a 2 pour mettre a jour le point de reference
871
 
      ixyzp0(iphas) = 2
872
 
!     en parallele on prend le numero du dernier proc sur lequel il y en a
873
 
      if (irangp.ge.0) then
874
 
        call parcmx(irangd)
875
 
        if (irangp.eq.irangd) then
876
 
          xyzref(1) = cdgfbo(1,ifadir)
877
 
          xyzref(2) = cdgfbo(2,ifadir)
878
 
          xyzref(3) = cdgfbo(3,ifadir)
879
 
        else
880
 
          xyzref(1) = 0.d0
881
 
          xyzref(2) = 0.d0
882
 
          xyzref(3) = 0.d0
883
 
        endif
884
 
        itrois = 3
885
 
        call parrsm(itrois,xyzref)
886
 
      else
887
 
        xyzref(1) = cdgfbo(1,ifadir)
888
 
        xyzref(2) = cdgfbo(2,ifadir)
889
 
        xyzref(3) = cdgfbo(3,ifadir)
890
 
      endif
 
712
        d0min = d0
 
713
      endif
 
714
    endif
 
715
  enddo
 
716
 
 
717
  irangd = irangp
 
718
  if (irangp.ge.0) call parfpt(ifadir, irangd, d0min)
 
719
 
 
720
  if (ifadir.gt.0) then
 
721
 
 
722
    ! on met ixyzp0 a 2 pour mettre a jour le point de reference
 
723
    ixyzp0 = 2
 
724
 
 
725
    if (irangp.eq.irangd) then
 
726
      xyzref(1) = cdgfbo(1,ifadir)
 
727
      xyzref(2) = cdgfbo(2,ifadir)
 
728
      xyzref(3) = cdgfbo(3,ifadir)
 
729
    endif
 
730
 
 
731
    ! Broadcast xyzref from irangd to all other ranks.
 
732
    if (irangp.ge.0) then
 
733
      inb = 3
 
734
      call parbcr(irangd, inb, xyzref)
891
735
    endif
892
736
 
893
737
  endif
894
738
 
 
739
endif
 
740
 
895
741
 
896
742
!   Si le point de reference n'a pas ete specifie par l'utilisateur
897
743
!   on le change et on decale alors COEFU s'il y a des sorties.
898
744
!   La pression totale dans PROPCE est aussi decalee (c'est a priori
899
745
!   inutile sauf si l'utilisateur l'utilise dans ustsns par exemple)
900
746
 
901
 
  if (ixyzp0(iphas).eq.2) then
902
 
    ixyzp0(iphas) = 1
903
 
    xxp0 = xyzref(1) - xyzp0(1,iphas)
904
 
    xyp0 = xyzref(2) - xyzp0(2,iphas)
905
 
    xzp0 = xyzref(3) - xyzp0(3,iphas)
906
 
    xyzp0(1,iphas) = xyzref(1)
907
 
    xyzp0(2,iphas) = xyzref(2)
908
 
    xyzp0(3,iphas) = xyzref(3)
909
 
    if (ippmod(icompf).lt.0) then
910
 
      iiptot = ipproc(iprtot(iphas))
911
 
      do iel = 1, ncelet
912
 
        propce(iel,iiptot) = propce(iel,iiptot)       &
913
 
             - ro0iph*( gx*xxp0 + gy*xyp0 + gz*xzp0 )
914
 
      enddo
915
 
    endif
916
 
    if (itbslb(iphas).gt.0) then
917
 
      write(nfecra,8000)iphas,xxp0,xyp0,xzp0
918
 
      do ifac = 1, nfabor
919
 
        coefu(ifac,1) = coefu(ifac,1)                             &
920
 
             - ro0iph*( gx*xxp0 + gy*xyp0 + gz*xzp0 )
921
 
      enddo
922
 
      coefup = coefup - ro0iph*( gx*xxp0 + gy*xyp0 + gz*xzp0 )
923
 
    else
924
 
      write(nfecra,8001)iphas,xxp0,xyp0,xzp0
925
 
    endif
926
 
  elseif (ixyzp0(iphas).eq.-1) then
927
 
!     Il n'y a pas de sorties ni de Dirichlet et l'utilisateur n'a
928
 
!     rien specifie -> on met IXYZP0 a 0 pour ne plus y toucher, tout
929
 
!     en differenciant du cas =1 qui necessitera une ecriture en suite
930
 
    ixyzp0(iphas) = 0
931
 
  endif
 
747
if (ixyzp0.eq.2) then
 
748
  ixyzp0 = 1
 
749
  xxp0 = xyzref(1) - xyzp0(1)
 
750
  xyp0 = xyzref(2) - xyzp0(2)
 
751
  xzp0 = xyzref(3) - xyzp0(3)
 
752
  xyzp0(1) = xyzref(1)
 
753
  xyzp0(2) = xyzref(2)
 
754
  xyzp0(3) = xyzref(3)
 
755
  if (ippmod(icompf).lt.0) then
 
756
    iiptot = ipproc(iprtot)
 
757
    do iel = 1, ncelet
 
758
      propce(iel,iiptot) = propce(iel,iiptot)       &
 
759
           - ro0*( gx*xxp0 + gy*xyp0 + gz*xzp0 )
 
760
    enddo
 
761
  endif
 
762
  if (itbslb.gt.0) then
 
763
    write(nfecra,8000)xxp0,xyp0,xzp0
 
764
    do ifac = 1, nfabor
 
765
      coefu(ifac) = coefu(ifac) - ro0*( gx*xxp0 + gy*xyp0 + gz*xzp0 )
 
766
    enddo
 
767
    coefup = coefup - ro0*( gx*xxp0 + gy*xyp0 + gz*xzp0 )
 
768
  else
 
769
    write(nfecra,8001)xxp0,xyp0,xzp0
 
770
  endif
 
771
elseif (ixyzp0.eq.-1) then
 
772
  !     Il n'y a pas de sorties ni de Dirichlet et l'utilisateur n'a
 
773
  !     rien specifie -> on met IXYZP0 a 0 pour ne plus y toucher, tout
 
774
  !     en differenciant du cas =1 qui necessitera une ecriture en suite
 
775
  ixyzp0 = 0
 
776
endif
932
777
 
933
778
!     La pression totale doit etre recalee en Xref a la valeur
934
779
!     Po + rho_0*g.(Xref-X0)
935
 
  if (itbslb(iphas).gt.0) then
936
 
    xxp0 = xyzp0(1,iphas)
937
 
    xyp0 = xyzp0(2,iphas)
938
 
    xzp0 = xyzp0(3,iphas)
939
 
    pref = p0(iphas)                                              &
940
 
         + ro0iph*( gx*(xyzref(1)-xxp0)                           &
941
 
                  + gy*(xyzref(2)-xyp0)                           &
942
 
                  + gz*(xyzref(3)-xzp0) )                         &
943
 
         - coefup
944
 
  endif
 
780
if (itbslb.gt.0) then
 
781
  xxp0 = xyzp0(1)
 
782
  xyp0 = xyzp0(2)
 
783
  xzp0 = xyzp0(3)
 
784
  pref = p0                                            &
 
785
       + ro0*( gx*(xyzref(1)-xxp0)                     &
 
786
       + gy*(xyzref(2)-xyp0)                           &
 
787
       + gz*(xyzref(3)-xzp0) )                         &
 
788
       - coefup
 
789
endif
945
790
 
946
791
 
947
792
! ---> Entree/Sortie libre
948
793
 
949
 
  ideb = idebty(isolib,iphas)
950
 
  ifin = ifinty(isolib,iphas)
951
 
 
952
 
  do ivar = 1, nvar
953
 
    if (ivar.eq.ipriph) then
954
 
      if(iprnew.eq.1) then
955
 
        do ii = ideb, ifin
956
 
          ifac = itrifb(ii,iphas)
957
 
          if(icodcl(ifac,ivar).eq.0) then
958
 
            icodcl(ifac,ivar)   = 1
959
 
            rcodcl(ifac,ivar,1) = coefu(ifac,1) + pref
960
 
            rcodcl(ifac,ivar,2) = rinfin
961
 
            rcodcl(ifac,ivar,3) = 0.d0
962
 
          endif
963
 
        enddo
964
 
      endif
965
 
    elseif(ivar.eq.iuiph.or.ivar.eq.iviph.or.ivar.eq.iwiph) then
966
 
      do ii = ideb, ifin
967
 
        ifac = itrifb(ii,iphas)
968
 
        if(icodcl(ifac,ivar).eq.0) then
969
 
          icodcl(ifac,ivar)   = 9
970
 
          rcodcl(ifac,ivar,1) = 0.d0
971
 
          rcodcl(ifac,ivar,2) = rinfin
972
 
          rcodcl(ifac,ivar,3) = 0.d0
973
 
        endif
974
 
      enddo
975
 
    endif
976
 
  enddo
 
794
ideb = idebty(isolib)
 
795
ifin = ifinty(isolib)
 
796
 
 
797
do ivar = 1, nvar
 
798
  if (ivar.eq.ipr) then
 
799
    do ii = ideb, ifin
 
800
      ifac = itrifb(ii)
 
801
      if(icodcl(ifac,ivar).eq.0) then
 
802
        icodcl(ifac,ivar)   = 1
 
803
        rcodcl(ifac,ivar,1) = coefu(ifac) + pref
 
804
        rcodcl(ifac,ivar,2) = rinfin
 
805
        rcodcl(ifac,ivar,3) = 0.d0
 
806
      endif
 
807
    enddo
 
808
  elseif(ivar.eq.iu.or.ivar.eq.iv.or.ivar.eq.iw) then
 
809
    do ii = ideb, ifin
 
810
      ifac = itrifb(ii)
 
811
      if(icodcl(ifac,ivar).eq.0) then
 
812
        icodcl(ifac,ivar)   = 9
 
813
        rcodcl(ifac,ivar,1) = 0.d0
 
814
        rcodcl(ifac,ivar,2) = rinfin
 
815
        rcodcl(ifac,ivar,3) = 0.d0
 
816
      endif
 
817
    enddo
 
818
  endif
 
819
enddo
 
820
 
 
821
! Free memory
 
822
deallocate(coefu)
977
823
 
978
824
 
979
825
! 6.3 SYMETRIE
982
828
! ---> Les vecteurs et tenseurs ont un traitement particulier
983
829
!        le reste Neumann sera traite plus tard
984
830
 
985
 
  ideb = idebty(isymet,iphas)
986
 
  ifin = ifinty(isymet,iphas)
 
831
ideb = idebty(isymet)
 
832
ifin = ifinty(isymet)
987
833
 
988
 
  do ivar = 1, nvar
989
 
    if ( ivar.eq.iuiph.or.ivar.eq.iviph.or.ivar.eq.iwiph.or.      &
990
 
       ( itytur(iphas).eq.3.and.                                  &
991
 
          (ivar.eq.ir11ip.or.ivar.eq.ir22ip.or.ivar.eq.ir33ip.or. &
992
 
           ivar.eq.ir12ip.or.ivar.eq.ir13ip.or.ivar.eq.ir23ip)    &
993
 
                                                          ) ) then
994
 
      do ii = ideb, ifin
995
 
        ifac = itrifb(ii,iphas)
996
 
        if(icodcl(ifac,ivar).eq.0) then
997
 
          icodcl(ifac,ivar)   = 4
998
 
!         rcodcl(ifac,ivar,1) = Modifie eventuellement par l'ALE
999
 
          rcodcl(ifac,ivar,2) = rinfin
1000
 
          rcodcl(ifac,ivar,3) = 0.d0
1001
 
        endif
1002
 
      enddo
1003
 
    elseif(ivar.eq.ipriph) then
1004
 
      if(iprnew.eq.1) then
1005
 
        do ii = ideb, ifin
1006
 
          ifac = itrifb(ii,iphas)
1007
 
          if(icodcl(ifac,ivar).eq.0) then
1008
 
            icodcl(ifac,ivar)   = 3
1009
 
            rcodcl(ifac,ivar,1) = 0.d0
1010
 
            rcodcl(ifac,ivar,2) = rinfin
1011
 
            rcodcl(ifac,ivar,3) = 0.d0
1012
 
          endif
1013
 
        enddo
1014
 
      endif
1015
 
    endif
1016
 
  enddo
 
834
do ivar = 1, nvar
 
835
  if ( ivar.eq.iu.or.ivar.eq.iv.or.ivar.eq.iw.or.         &
 
836
       ( itytur.eq.3.and.                                 &
 
837
       (ivar.eq.ir11.or.ivar.eq.ir22.or.ivar.eq.ir33.or.  &
 
838
       ivar.eq.ir12.or.ivar.eq.ir13.or.ivar.eq.ir23)      &
 
839
       ) ) then
 
840
    do ii = ideb, ifin
 
841
      ifac = itrifb(ii)
 
842
      if(icodcl(ifac,ivar).eq.0) then
 
843
        icodcl(ifac,ivar)   = 4
 
844
        !         rcodcl(ifac,ivar,1) = Modifie eventuellement par l'ALE
 
845
        rcodcl(ifac,ivar,2) = rinfin
 
846
        rcodcl(ifac,ivar,3) = 0.d0
 
847
      endif
 
848
    enddo
 
849
  elseif(ivar.eq.ipr) then
 
850
    do ii = ideb, ifin
 
851
      ifac = itrifb(ii)
 
852
      if(icodcl(ifac,ivar).eq.0) then
 
853
        icodcl(ifac,ivar)   = 3
 
854
        rcodcl(ifac,ivar,1) = 0.d0
 
855
        rcodcl(ifac,ivar,2) = rinfin
 
856
        rcodcl(ifac,ivar,3) = 0.d0
 
857
      endif
 
858
    enddo
 
859
  endif
 
860
enddo
1017
861
 
1018
862
! 6.4 PAROI LISSE
1019
863
! ===============
1021
865
! ---> La vitesse et les grandeurs turbulentes ont le code 5
1022
866
!        le reste Neumann sera traite plus tard
1023
867
 
1024
 
  ideb = idebty(iparoi,iphas)
1025
 
  ifin = ifinty(iparoi,iphas)
 
868
ideb = idebty(iparoi)
 
869
ifin = ifinty(iparoi)
1026
870
 
1027
 
  do ivar = 1, nvar
1028
 
    if ( ivar.eq.iuiph.or.ivar.eq.iviph.or.ivar.eq.iwiph) then
1029
 
      do ii = ideb, ifin
1030
 
        ifac = itrifb(ii,iphas)
1031
 
        if(icodcl(ifac,ivar).eq.0) then
1032
 
          icodcl(ifac,ivar)   = 5
1033
 
!         rcodcl(ifac,ivar,1) = Utilisateur
1034
 
          rcodcl(ifac,ivar,2) = rinfin
1035
 
          rcodcl(ifac,ivar,3) = 0.d0
1036
 
        endif
1037
 
      enddo
1038
 
    elseif (                                                      &
1039
 
       ( itytur(iphas).eq.2.and.                                  &
1040
 
          (ivar.eq.ikiph  .or.ivar.eq.iepiph) ).or.               &
1041
 
       ( itytur(iphas).eq.3.and.                                  &
1042
 
          (ivar.eq.ir11ip.or.ivar.eq.ir22ip.or.ivar.eq.ir33ip.or. &
1043
 
           ivar.eq.ir12ip.or.ivar.eq.ir13ip.or.ivar.eq.ir23ip.or. &
1044
 
           ivar.eq.iepiph)                    ).or.               &
1045
 
       ( iturb(iphas).eq.50.and.                                  &
1046
 
          (ivar.eq.ikiph.or.ivar.eq.iepiph.or.ivar.eq.iphiph.or.  &
1047
 
           ivar.eq.ifbiph)                    ).or.               &
1048
 
       ( iturb(iphas).eq.60.and.                                  &
1049
 
          (ivar.eq.ikiph.or.ivar.eq.iomgip)   ) ) then
1050
 
      do ii = ideb, ifin
1051
 
        ifac = itrifb(ii,iphas)
1052
 
        if(icodcl(ifac,ivar).eq.0) then
1053
 
          icodcl(ifac,ivar)   = 5
1054
 
          rcodcl(ifac,ivar,1) = 0.d0
1055
 
          rcodcl(ifac,ivar,2) = rinfin
1056
 
          rcodcl(ifac,ivar,3) = 0.d0
1057
 
        endif
1058
 
      enddo
1059
 
    elseif(ivar.eq.ipriph) then
1060
 
      if(iprnew.eq.1) then
1061
 
        do ii = ideb, ifin
1062
 
          ifac = itrifb(ii,iphas)
1063
 
          if(icodcl(ifac,ivar).eq.0) then
1064
 
            icodcl(ifac,ivar)   = 3
1065
 
            rcodcl(ifac,ivar,1) = 0.d0
1066
 
            rcodcl(ifac,ivar,2) = rinfin
1067
 
            rcodcl(ifac,ivar,3) = 0.d0
1068
 
          endif
1069
 
        enddo
1070
 
      endif
1071
 
    endif
1072
 
  enddo
 
871
do ivar = 1, nvar
 
872
  if ( ivar.eq.iu.or.ivar.eq.iv.or.ivar.eq.iw) then
 
873
    do ii = ideb, ifin
 
874
      ifac = itrifb(ii)
 
875
      if(icodcl(ifac,ivar).eq.0) then
 
876
        icodcl(ifac,ivar)   = 5
 
877
        !         rcodcl(ifac,ivar,1) = Utilisateur
 
878
        rcodcl(ifac,ivar,2) = rinfin
 
879
        rcodcl(ifac,ivar,3) = 0.d0
 
880
      endif
 
881
    enddo
 
882
  elseif (                                                      &
 
883
       ( itytur.eq.2.and.                                  &
 
884
       (ivar.eq.ik  .or.ivar.eq.iep) ).or.               &
 
885
       ( itytur.eq.3.and.                                  &
 
886
       (ivar.eq.ir11.or.ivar.eq.ir22.or.ivar.eq.ir33.or. &
 
887
       ivar.eq.ir12.or.ivar.eq.ir13.or.ivar.eq.ir23.or. &
 
888
       ivar.eq.iep)                    ).or.               &
 
889
       ( iturb.eq.50.and.                                  &
 
890
       (ivar.eq.ik.or.ivar.eq.iep.or.ivar.eq.iphi.or.  &
 
891
       ivar.eq.ifb)                    ).or.               &
 
892
       ( iturb.eq.51.and.                                  &
 
893
       (ivar.eq.ik.or.ivar.eq.iep.or.ivar.eq.iphi.or.  &
 
894
       ivar.eq.ial)                    ).or.               &
 
895
       ( iturb.eq.60.and.                                  &
 
896
       (ivar.eq.ik.or.ivar.eq.iomg)   ).or.               &
 
897
       ( iturb.eq.70.and.                                  &
 
898
       (ivar.eq.inusa)                    )    ) then
 
899
    do ii = ideb, ifin
 
900
      ifac = itrifb(ii)
 
901
      if(icodcl(ifac,ivar).eq.0) then
 
902
        icodcl(ifac,ivar)   = 5
 
903
        rcodcl(ifac,ivar,1) = 0.d0
 
904
        rcodcl(ifac,ivar,2) = rinfin
 
905
        rcodcl(ifac,ivar,3) = 0.d0
 
906
      endif
 
907
    enddo
 
908
  elseif(ivar.eq.ipr) then
 
909
    do ii = ideb, ifin
 
910
      ifac = itrifb(ii)
 
911
      if(icodcl(ifac,ivar).eq.0) then
 
912
        icodcl(ifac,ivar)   = 3
 
913
        rcodcl(ifac,ivar,1) = 0.d0
 
914
        rcodcl(ifac,ivar,2) = rinfin
 
915
        rcodcl(ifac,ivar,3) = 0.d0
 
916
      endif
 
917
    enddo
 
918
  endif
 
919
enddo
1073
920
 
1074
921
! 6.5 PAROI RUGUEUSE
1075
922
! ==================
1078
925
!      la rugosite est stockee dans rcodcl(..,..,3)
1079
926
!      le reste Neumann sera traite plus tard (idem paroi lisse)
1080
927
 
1081
 
  ideb = idebty(iparug,iphas)
1082
 
  ifin = ifinty(iparug,iphas)
1083
 
 
1084
 
  do ivar = 1, nvar
1085
 
    if ( ivar.eq.iuiph.or.ivar.eq.iviph.or.ivar.eq.iwiph) then
1086
 
      do ii = ideb, ifin
1087
 
        ifac = itrifb(ii,iphas)
1088
 
        if(icodcl(ifac,ivar).eq.0) then
1089
 
          icodcl(ifac,ivar)   = 6
1090
 
!         rcodcl(ifac,ivar,1) = Utilisateur
1091
 
          rcodcl(ifac,ivar,2) = rinfin
1092
 
!         rcodcl(ifac,ivar,3) = Utilisateur
1093
 
        endif
1094
 
      enddo
1095
 
    elseif (                                                      &
1096
 
       ( itytur(iphas).eq.2.and.                                  &
1097
 
          (ivar.eq.ikiph  .or.ivar.eq.iepiph) ).or.               &
1098
 
       ( itytur(iphas).eq.3.and.                                  &
1099
 
          (ivar.eq.ir11ip.or.ivar.eq.ir22ip.or.ivar.eq.ir33ip.or. &
1100
 
           ivar.eq.ir12ip.or.ivar.eq.ir13ip.or.ivar.eq.ir23ip.or. &
1101
 
           ivar.eq.iepiph)                    ).or.               &
1102
 
       ( iturb(iphas).eq.50.and.                                  &
1103
 
          (ivar.eq.ikiph.or.ivar.eq.iepiph.or.ivar.eq.iphiph.or.  &
1104
 
           ivar.eq.ifbiph)                    ).or.               &
1105
 
       ( iturb(iphas).eq.60.and.                                  &
1106
 
          (ivar.eq.ikiph.or.ivar.eq.iomgip)   ) ) then
1107
 
      do ii = ideb, ifin
1108
 
        ifac = itrifb(ii,iphas)
1109
 
        if(icodcl(ifac,ivar).eq.0) then
1110
 
          icodcl(ifac,ivar)   = 6
1111
 
          rcodcl(ifac,ivar,1) = 0.d0
1112
 
          rcodcl(ifac,ivar,2) = rinfin
1113
 
          rcodcl(ifac,ivar,3) = 0.d0
1114
 
        endif
1115
 
      enddo
1116
 
    elseif(ivar.eq.ipriph) then
1117
 
      if(iprnew.eq.1) then
1118
 
        do ii = ideb, ifin
1119
 
          ifac = itrifb(ii,iphas)
1120
 
          if(icodcl(ifac,ivar).eq.0) then
1121
 
            icodcl(ifac,ivar)   = 3
1122
 
            rcodcl(ifac,ivar,1) = 0.d0
1123
 
            rcodcl(ifac,ivar,2) = rinfin
1124
 
            rcodcl(ifac,ivar,3) = 0.d0
1125
 
          endif
1126
 
        enddo
1127
 
      endif
1128
 
    endif
1129
 
  enddo
1130
 
 
1131
 
 
 
928
ideb = idebty(iparug)
 
929
ifin = ifinty(iparug)
 
930
 
 
931
do ivar = 1, nvar
 
932
  if ( ivar.eq.iu.or.ivar.eq.iv.or.ivar.eq.iw) then
 
933
    do ii = ideb, ifin
 
934
      ifac = itrifb(ii)
 
935
      if(icodcl(ifac,ivar).eq.0) then
 
936
        icodcl(ifac,ivar)   = 6
 
937
        !         rcodcl(ifac,ivar,1) = Utilisateur
 
938
        rcodcl(ifac,ivar,2) = rinfin
 
939
        !         rcodcl(ifac,ivar,3) = Utilisateur
 
940
      endif
 
941
    enddo
 
942
  elseif (                                                      &
 
943
       ( itytur.eq.2.and.                                  &
 
944
       (ivar.eq.ik  .or.ivar.eq.iep) ).or.               &
 
945
       ( itytur.eq.3.and.                                  &
 
946
       (ivar.eq.ir11.or.ivar.eq.ir22.or.ivar.eq.ir33.or. &
 
947
       ivar.eq.ir12.or.ivar.eq.ir13.or.ivar.eq.ir23.or. &
 
948
       ivar.eq.iep)                    ).or.               &
 
949
       ( iturb.eq.50.and.                                  &
 
950
       (ivar.eq.ik.or.ivar.eq.iep.or.ivar.eq.iphi.or.  &
 
951
       ivar.eq.ifb)                    ).or.               &
 
952
       ( iturb.eq.51.and.                                  &
 
953
       (ivar.eq.ik.or.ivar.eq.iep.or.ivar.eq.iphi.or.  &
 
954
       ivar.eq.ial)                    ).or.               &
 
955
       ( iturb.eq.60.and.                                  &
 
956
       (ivar.eq.ik.or.ivar.eq.iomg)   ).or.               &
 
957
       ( iturb.eq.70.and.                                  &
 
958
       (ivar.eq.inusa)                    )    ) then
 
959
    do ii = ideb, ifin
 
960
      ifac = itrifb(ii)
 
961
      if(icodcl(ifac,ivar).eq.0) then
 
962
        icodcl(ifac,ivar)   = 6
 
963
        rcodcl(ifac,ivar,1) = 0.d0
 
964
        rcodcl(ifac,ivar,2) = rinfin
 
965
        rcodcl(ifac,ivar,3) = 0.d0
 
966
      endif
 
967
    enddo
 
968
  elseif(ivar.eq.ipr) then
 
969
    do ii = ideb, ifin
 
970
      ifac = itrifb(ii)
 
971
      if(icodcl(ifac,ivar).eq.0) then
 
972
        icodcl(ifac,ivar)   = 3
 
973
        rcodcl(ifac,ivar,1) = 0.d0
 
974
        rcodcl(ifac,ivar,2) = rinfin
 
975
        rcodcl(ifac,ivar,3) = 0.d0
 
976
      endif
 
977
    enddo
 
978
  endif
1132
979
enddo
1133
 
! --- Boucle sur les phases : fin
1134
 
 
1135
980
 
1136
981
!===============================================================================
1137
982
! 6.bis  CONVERSION EN RCODCL ICODCL
1141
986
!    TRAITEMENT PARTICULIER (HORS PRESSION, VITESSE ...)
1142
987
!===============================================================================
1143
988
 
1144
 
! --- Boucle sur les phases : debut
1145
 
do iphas = 1, nphas
1146
 
 
1147
 
 
1148
989
! 6.1 ENTREE bis
1149
990
! ===========
1150
991
 
1153
994
!     Dirichlet si l'utilisateur fournit une valeur, sinon on utilise
1154
995
!     Neumann homogene si le flux de masse est sortant (erreur sinon).
1155
996
 
1156
 
  ideb = idebty(ientre,iphas)
1157
 
  ifin = ifinty(ientre,iphas)
1158
 
 
1159
 
  iok = 0
1160
 
  do ivar = 1, nvar
1161
 
    do ii = ideb, ifin
1162
 
      ifac = itrifb(ii,iphas)
1163
 
      if(icodcl(ifac,ivar).eq.0) then
1164
 
 
1165
 
        if (ivar.eq.iuiph.or.ivar.eq.iviph.or.ivar.eq.iwiph)      &
1166
 
             then
1167
 
          if (rcodcl(ifac,ivar,1).gt.rinfin*0.5d0) then
1168
 
            itypfb(ifac,iphas) = - abs(itypfb(ifac,iphas))
1169
 
            if (iok.eq.0.or.iok.eq.2) iok = iok + 1
1170
 
          else
1171
 
            icodcl(ifac,ivar) = 1
1172
 
!           rcodcl(ifac,ivar,1) = Utilisateur
1173
 
            rcodcl(ifac,ivar,2) = rinfin
1174
 
            rcodcl(ifac,ivar,3) = 0.d0
1175
 
          endif
1176
 
 
1177
 
        elseif (rcodcl(ifac,ivar,1).gt.rinfin*0.5d0) then
1178
 
 
1179
 
          flumbf = propfb(ifac,ipprob(ifluma(iuiph)))
1180
 
          if( flumbf.ge.-epzero) then
1181
 
            icodcl(ifac,ivar)   = 3
1182
 
            rcodcl(ifac,ivar,1) = 0.d0
1183
 
            rcodcl(ifac,ivar,2) = rinfin
1184
 
            rcodcl(ifac,ivar,3) = 0.d0
1185
 
          else
1186
 
            itypfb(ifac,iphas) = - abs(itypfb(ifac,iphas))
1187
 
            if (iok.lt.2) iok = iok + 2
1188
 
          endif
 
997
ideb = idebty(ientre)
 
998
ifin = ifinty(ientre)
 
999
 
 
1000
iok = 0
 
1001
do ivar = 1, nvar
 
1002
  do ii = ideb, ifin
 
1003
    ifac = itrifb(ii)
 
1004
    if(icodcl(ifac,ivar).eq.0) then
 
1005
 
 
1006
      if (ivar.eq.iu.or.ivar.eq.iv.or.ivar.eq.iw)      &
 
1007
           then
 
1008
        if (rcodcl(ifac,ivar,1).gt.rinfin*0.5d0) then
 
1009
          itypfb(ifac) = - abs(itypfb(ifac))
 
1010
          if (iok.eq.0.or.iok.eq.2) iok = iok + 1
1189
1011
        else
1190
1012
          icodcl(ifac,ivar) = 1
1191
 
!         rcodcl(ifac,ivar,1) = Utilisateur
1192
 
          rcodcl(ifac,ivar,2) = rinfin
1193
 
          rcodcl(ifac,ivar,3) = 0.d0
1194
 
        endif
1195
 
 
 
1013
          !           rcodcl(ifac,ivar,1) = Utilisateur
 
1014
          rcodcl(ifac,ivar,2) = rinfin
 
1015
          rcodcl(ifac,ivar,3) = 0.d0
 
1016
        endif
 
1017
 
 
1018
      elseif (rcodcl(ifac,ivar,1).gt.rinfin*0.5d0) then
 
1019
 
 
1020
        flumbf = propfb(ifac,ipprob(ifluma(iu)))
 
1021
        if( flumbf.ge.-epzero) then
 
1022
          icodcl(ifac,ivar)   = 3
 
1023
          rcodcl(ifac,ivar,1) = 0.d0
 
1024
          rcodcl(ifac,ivar,2) = rinfin
 
1025
          rcodcl(ifac,ivar,3) = 0.d0
 
1026
        else
 
1027
          itypfb(ifac) = - abs(itypfb(ifac))
 
1028
          if (iok.lt.2) iok = iok + 2
 
1029
        endif
 
1030
      else
 
1031
        icodcl(ifac,ivar) = 1
 
1032
        !         rcodcl(ifac,ivar,1) = Utilisateur
 
1033
        rcodcl(ifac,ivar,2) = rinfin
 
1034
        rcodcl(ifac,ivar,3) = 0.d0
1196
1035
      endif
1197
 
    enddo
 
1036
 
 
1037
    endif
1198
1038
  enddo
 
1039
enddo
1199
1040
 
1200
 
  if (irangp.ge.0) call parcmx(iok)
1201
 
  if (iok.gt.0) then
1202
 
    if (iok.eq.1 .or. iok.eq.3) write(nfecra,6060)
1203
 
    if (iok.eq.2 .or. iok.eq.3) write(nfecra,6070)
1204
 
    call bcderr(nphas, itypfb)
1205
 
  endif
 
1041
if (irangp.ge.0) call parcmx(iok)
 
1042
if (iok.gt.0) then
 
1043
  if (iok.eq.1 .or. iok.eq.3) write(nfecra,6060)
 
1044
  if (iok.eq.2 .or. iok.eq.3) write(nfecra,6070)
 
1045
  call bcderr(itypfb)
 
1046
endif
1206
1047
 
1207
1048
 
1208
1049
 
1219
1060
 
1220
1061
! ---> Sortie ISOLIB
1221
1062
 
1222
 
  ideb = idebty(isolib,iphas)
1223
 
  ifin = ifinty(isolib,iphas)
1224
 
 
1225
 
  do ivar = 1, nvar
1226
 
    do ii = ideb, ifin
1227
 
      ifac = itrifb(ii,iphas)
1228
 
      if(icodcl(ifac,ivar).eq.0) then
1229
 
 
1230
 
         if (rcodcl(ifac,ivar,1).gt.rinfin*0.5d0) then
1231
 
              icodcl(ifac,ivar) = 3
1232
 
              rcodcl(ifac,ivar,1) = 0.d0
1233
 
              rcodcl(ifac,ivar,2) = rinfin
1234
 
              rcodcl(ifac,ivar,3) = 0.d0
1235
 
          else
1236
 
              icodcl(ifac,ivar) = 1
1237
 
!             rcodcl(ifac,ivar,1) = Utilisateur
1238
 
              rcodcl(ifac,ivar,2) = rinfin
1239
 
              rcodcl(ifac,ivar,3) = 0.d0
1240
 
         endif
 
1063
ideb = idebty(isolib)
 
1064
ifin = ifinty(isolib)
 
1065
 
 
1066
do ivar = 1, nvar
 
1067
  do ii = ideb, ifin
 
1068
    ifac = itrifb(ii)
 
1069
    if(icodcl(ifac,ivar).eq.0) then
 
1070
 
 
1071
      if (rcodcl(ifac,ivar,1).gt.rinfin*0.5d0) then
 
1072
        icodcl(ifac,ivar) = 3
 
1073
        rcodcl(ifac,ivar,1) = 0.d0
 
1074
        rcodcl(ifac,ivar,2) = rinfin
 
1075
        rcodcl(ifac,ivar,3) = 0.d0
 
1076
      else
 
1077
        icodcl(ifac,ivar) = 1
 
1078
        !             rcodcl(ifac,ivar,1) = Utilisateur
 
1079
        rcodcl(ifac,ivar,2) = rinfin
 
1080
        rcodcl(ifac,ivar,3) = 0.d0
1241
1081
      endif
1242
 
    enddo
 
1082
    endif
1243
1083
  enddo
 
1084
enddo
1244
1085
 
1245
1086
 
1246
1087
 
1251
1092
!        traite plus haut
1252
1093
!        le reste Neumann
1253
1094
 
1254
 
  ideb = idebty(isymet,iphas)
1255
 
  ifin = ifinty(isymet,iphas)
 
1095
ideb = idebty(isymet)
 
1096
ifin = ifinty(isymet)
1256
1097
 
1257
 
  do ivar = 1, nvar
1258
 
    do ii = ideb, ifin
1259
 
      ifac = itrifb(ii,iphas)
1260
 
      if(icodcl(ifac,ivar).eq.0) then
1261
 
        icodcl(ifac,ivar)   = 3
1262
 
        rcodcl(ifac,ivar,1) = 0.d0
1263
 
        rcodcl(ifac,ivar,2) = rinfin
1264
 
        rcodcl(ifac,ivar,3) = 0.d0
1265
 
      endif
1266
 
    enddo
 
1098
do ivar = 1, nvar
 
1099
  do ii = ideb, ifin
 
1100
    ifac = itrifb(ii)
 
1101
    if(icodcl(ifac,ivar).eq.0) then
 
1102
      icodcl(ifac,ivar)   = 3
 
1103
      rcodcl(ifac,ivar,1) = 0.d0
 
1104
      rcodcl(ifac,ivar,2) = rinfin
 
1105
      rcodcl(ifac,ivar,3) = 0.d0
 
1106
    endif
1267
1107
  enddo
 
1108
enddo
1268
1109
 
1269
1110
! 6.4 PAROI LISSE bis
1270
1111
! ===============
1273
1114
!        traite plus haut
1274
1115
!        le reste Neumann
1275
1116
 
1276
 
  ideb = idebty(iparoi,iphas)
1277
 
  ifin = ifinty(iparoi,iphas)
 
1117
ideb = idebty(iparoi)
 
1118
ifin = ifinty(iparoi)
1278
1119
 
1279
 
  do ivar = 1, nvar
1280
 
    do ii = ideb, ifin
1281
 
      ifac = itrifb(ii,iphas)
1282
 
      if(icodcl(ifac,ivar).eq.0) then
1283
 
        icodcl(ifac,ivar)   = 3
1284
 
        rcodcl(ifac,ivar,1) = 0.d0
1285
 
        rcodcl(ifac,ivar,2) = rinfin
1286
 
        rcodcl(ifac,ivar,3) = 0.d0
1287
 
      endif
1288
 
    enddo
 
1120
do ivar = 1, nvar
 
1121
  do ii = ideb, ifin
 
1122
    ifac = itrifb(ii)
 
1123
    if(icodcl(ifac,ivar).eq.0) then
 
1124
      icodcl(ifac,ivar)   = 3
 
1125
      rcodcl(ifac,ivar,1) = 0.d0
 
1126
      rcodcl(ifac,ivar,2) = rinfin
 
1127
      rcodcl(ifac,ivar,3) = 0.d0
 
1128
    endif
1289
1129
  enddo
 
1130
enddo
1290
1131
 
1291
1132
! 6.5 PAROI RUGUEUSE bis
1292
1133
! ==================
1295
1136
!        traite plus haut
1296
1137
!        le reste Neumann
1297
1138
 
1298
 
  ideb = idebty(iparug,iphas)
1299
 
  ifin = ifinty(iparug,iphas)
 
1139
ideb = idebty(iparug)
 
1140
ifin = ifinty(iparug)
1300
1141
 
1301
 
  do ivar = 1, nvar
1302
 
    do ii = ideb, ifin
1303
 
      ifac = itrifb(ii,iphas)
1304
 
      if(icodcl(ifac,ivar).eq.0) then
1305
 
        icodcl(ifac,ivar)   = 3
1306
 
        rcodcl(ifac,ivar,1) = 0.d0
1307
 
        rcodcl(ifac,ivar,2) = rinfin
1308
 
        rcodcl(ifac,ivar,3) = 0.d0
1309
 
      endif
1310
 
    enddo
 
1142
do ivar = 1, nvar
 
1143
  do ii = ideb, ifin
 
1144
    ifac = itrifb(ii)
 
1145
    if(icodcl(ifac,ivar).eq.0) then
 
1146
      icodcl(ifac,ivar)   = 3
 
1147
      rcodcl(ifac,ivar,1) = 0.d0
 
1148
      rcodcl(ifac,ivar,2) = rinfin
 
1149
      rcodcl(ifac,ivar,3) = 0.d0
 
1150
    endif
1311
1151
  enddo
1312
 
 
1313
1152
enddo
1314
 
! --- Boucle sur les phases : fin
 
1153
 
1315
1154
!===============================================================================
1316
1155
! 7.  RENFORCEMENT DIAGONALE DE LA MATRICE SI AUCUN POINTS DIRICHLET
1317
1156
!===============================================================================
1347
1186
!===============================================================================
1348
1187
 
1349
1188
iwaru = -1
1350
 
do iphas = 1, nphas
1351
 
  iuiph  = iu(iphas)
1352
 
  iwaru = max(iwarni(iuiph),iwaru)
1353
 
enddo
 
1189
iwaru = max(iwarni(iu),iwaru)
1354
1190
if (irangp.ge.0) call parcmx(iwaru)
1355
1191
 
1356
1192
if(iwaru.ge.1 .or. mod(ntcabs,ntlist).eq.0                        &
1358
1194
  write(nfecra,7010)
1359
1195
endif
1360
1196
 
1361
 
do iphas = 1, nphas
1362
 
 
1363
 
  iuiph  = iu(iphas)
1364
 
  iflmab = ipprob(ifluma(iuiph))
1365
 
 
1366
 
  iwrnp = iwarni(iu(iphas))
1367
 
  if (irangp.ge.0) call parcmx (iwrnp)
1368
 
                   !==========
 
1197
iflmab = ipprob(ifluma(iu))
 
1198
 
 
1199
iwrnp = iwarni(iu)
 
1200
if (irangp.ge.0) call parcmx (iwrnp)
 
1201
!==========
1369
1202
 
1370
1203
!     On ecrit le flux de masse si IWARNI>0, a la periodicite NTLIST
1371
1204
!     et au deux premiers et deux derniers pas de temps.
1372
 
  if(iwrnp.ge.1 .or. mod(ntcabs,ntlist).eq.0                      &
1373
 
       .or.(ntcabs.le.ntpabs+2).or.(ntcabs.ge.ntmabs-1)) then
1374
 
 
1375
 
    do ii = 1, ntypmx
1376
 
      flumty(ii) = 0.d0
1377
 
    enddo
1378
 
 
1379
 
    do ii = 1, ntypmx
1380
 
      ideb = idebty(ii,iphas)
1381
 
      ifin = ifinty(ii,iphas)
1382
 
      do jj = ideb, ifin
1383
 
        ifac = itrifb(jj,iphas)
1384
 
        flumty(ii) = flumty(ii) + propfb(ifac,iflmab)
1385
 
      enddo
1386
 
    enddo
1387
 
 
1388
 
 
1389
 
    write(nfecra,7011) iphas
1390
 
 
1391
 
    if (ippmod(icompf).lt.0 ) then
1392
 
 
1393
 
      ii = ientre
1394
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
1395
 
      if (irangp.ge.0) then
1396
 
        call parcpt (inb)
1397
 
        call parsom (flumty(ii))
1398
 
      endif
1399
 
#if defined(_CS_LANG_FR)
1400
 
      write(nfecra,7020) 'Entree           ',ii,inb,flumty(ii)
1401
 
#else
1402
 
      write(nfecra,7020) 'Inlet            ',ii,inb,flumty(ii)
1403
 
#endif
1404
 
      ii = iparoi
1405
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
1406
 
      if (irangp.ge.0) then
1407
 
        call parcpt (inb)
1408
 
        call parsom (flumty(ii))
1409
 
      endif
1410
 
#if defined(_CS_LANG_FR)
1411
 
      write(nfecra,7020) 'Paroi lisse      ',ii,inb,flumty(ii)
1412
 
#else
1413
 
      write(nfecra,7020) 'Smooth wall      ',ii,inb,flumty(ii)
1414
 
#endif
1415
 
      ii = iparug
1416
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
1417
 
      if (irangp.ge.0) then
1418
 
        call parcpt (inb)
1419
 
        call parsom (flumty(ii))
1420
 
      endif
1421
 
#if defined(_CS_LANG_FR)
1422
 
      write(nfecra,7020) 'Paroi rugueuse   ',ii,inb,flumty(ii)
1423
 
#else
1424
 
      write(nfecra,7020) 'Rough wall       ',ii,inb,flumty(ii)
1425
 
#endif
1426
 
      ii = isymet
1427
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
1428
 
      if (irangp.ge.0) then
1429
 
        call parcpt (inb)
1430
 
        call parsom (flumty(ii))
1431
 
      endif
1432
 
#if defined(_CS_LANG_FR)
1433
 
      write(nfecra,7020) 'Symetrie         ',ii,inb,flumty(ii)
1434
 
#else
1435
 
      write(nfecra,7020) 'Symmetry         ',ii,inb,flumty(ii)
1436
 
#endif
1437
 
 
1438
 
      ii = isolib
1439
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
1440
 
      if (irangp.ge.0) then
1441
 
        call parcpt (inb)
1442
 
        call parsom (flumty(ii))
1443
 
      endif
1444
 
#if defined(_CS_LANG_FR)
1445
 
      write(nfecra,7020) 'Sortie libre     ',ii,inb,flumty(ii)
1446
 
#else
1447
 
      write(nfecra,7020) 'Free outlet      ',ii,inb,flumty(ii)
1448
 
#endif
1449
 
 
1450
 
      if (nbrcpl.ge.1) then
1451
 
        ii = icscpl
1452
 
        inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
1453
 
        if (irangp.ge.0) then
1454
 
          call parcpt (inb)
1455
 
          call parsom (flumty(ii))
1456
 
        endif
1457
 
#if defined(_CS_LANG_FR)
1458
 
        write(nfecra,7020) 'Couplage sat/sat ',ii,inb,flumty(ii)
1459
 
#else
1460
 
        write(nfecra,7020) 'Sat/Sat coupling ',ii,inb,flumty(ii)
1461
 
#endif
1462
 
      endif
1463
 
 
1464
 
      ii = iindef
1465
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
1466
 
      if (irangp.ge.0) then
1467
 
        call parcpt (inb)
1468
 
        call parsom (flumty(ii))
1469
 
      endif
1470
 
#if defined(_CS_LANG_FR)
1471
 
      write(nfecra,7020) 'Indefini         ',ii,inb,flumty(ii)
1472
 
#else
1473
 
      write(nfecra,7020) 'Undefined        ',ii,inb,flumty(ii)
1474
 
#endif
1475
 
 
1476
 
      do ii = 1, ntypmx
1477
 
        if( ii.ne.ientre .and.                                    &
1478
 
            ii.ne.iparoi .and.                                    &
1479
 
            ii.ne.iparug .and.                                    &
1480
 
            ii.ne.isymet .and.                                    &
1481
 
            ii.ne.isolib .and.                                    &
1482
 
            ii.ne.icscpl .and.                                    &
1483
 
            ii.ne.iindef ) then
1484
 
          inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
1485
 
          if (irangp.ge.0) then
1486
 
            call parcpt (inb)
1487
 
            call parsom (flumty(ii))
1488
 
          endif
1489
 
          if(inb.gt.0) then
1490
 
#if defined(_CS_LANG_FR)
1491
 
            write(nfecra,7020) 'Type utilisateur ',ii,inb,flumty(ii)
1492
 
#else
1493
 
            write(nfecra,7020) 'User type        ',ii,inb,flumty(ii)
1494
 
#endif
1495
 
          endif
1496
 
        endif
1497
 
      enddo
1498
 
 
1499
 
    else
1500
 
 
1501
 
      ii = ieqhcf
1502
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
1503
 
      if (irangp.ge.0) then
1504
 
        call parcpt (inb)
1505
 
        call parsom (flumty(ii))
1506
 
      endif
1507
 
#if defined(_CS_LANG_FR)
1508
 
      write(nfecra,7020) 'Entree sub. enth.',ii,inb,flumty(ii)
1509
 
#else
1510
 
      write(nfecra,7020) 'Sub. enth. inlet ',ii,inb,flumty(ii)
1511
 
#endif
1512
 
 
1513
 
      ii = ierucf
1514
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
1515
 
      if (irangp.ge.0) then
1516
 
        call parcpt (inb)
1517
 
        call parsom (flumty(ii))
1518
 
      endif
1519
 
#if defined(_CS_LANG_FR)
1520
 
      write(nfecra,7020) 'Entree subsonique',ii,inb,flumty(ii)
1521
 
#else
1522
 
      write(nfecra,7020) 'Subsonic inlet   ',ii,inb,flumty(ii)
1523
 
#endif
1524
 
 
1525
 
      ii = iesicf
1526
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
1527
 
      if (irangp.ge.0) then
1528
 
        call parcpt (inb)
1529
 
        call parsom (flumty(ii))
1530
 
      endif
1531
 
#if defined(_CS_LANG_FR)
1532
 
      write(nfecra,7020) 'Entree/Sortie imp',ii,inb,flumty(ii)
1533
 
#else
1534
 
      write(nfecra,7020) 'Imp inlet/outlet ',ii,inb,flumty(ii)
1535
 
#endif
1536
 
 
1537
 
      ii = isopcf
1538
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
1539
 
      if (irangp.ge.0) then
1540
 
        call parcpt (inb)
1541
 
        call parsom (flumty(ii))
1542
 
      endif
1543
 
#if defined(_CS_LANG_FR)
1544
 
      write(nfecra,7020) 'Sortie subsonique',ii,inb,flumty(ii)
1545
 
#else
1546
 
      write(nfecra,7020) 'Subsonic outlet  ',ii,inb,flumty(ii)
1547
 
#endif
1548
 
 
1549
 
      ii = isspcf
1550
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
1551
 
      if (irangp.ge.0) then
1552
 
        call parcpt (inb)
1553
 
        call parsom (flumty(ii))
1554
 
      endif
1555
 
#if defined(_CS_LANG_FR)
1556
 
      write(nfecra,7020) 'Sortie supersoniq',ii,inb,flumty(ii)
1557
 
#else
1558
 
      write(nfecra,7020) 'Supersonic outlet',ii,inb,flumty(ii)
1559
 
#endif
1560
 
 
1561
 
      ii = iparoi
1562
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
1563
 
      if (irangp.ge.0) then
1564
 
        call parcpt (inb)
1565
 
        call parsom (flumty(ii))
1566
 
      endif
1567
 
#if defined(_CS_LANG_FR)
1568
 
      write(nfecra,7020) 'Paroi            ',ii,inb,flumty(ii)
1569
 
#else
1570
 
      write(nfecra,7020) 'Wall             ',ii,inb,flumty(ii)
1571
 
#endif
1572
 
 
1573
 
      ii = isymet
1574
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
1575
 
      if (irangp.ge.0) then
1576
 
        call parcpt (inb)
1577
 
        call parsom (flumty(ii))
1578
 
      endif
1579
 
#if defined(_CS_LANG_FR)
1580
 
      write(nfecra,7020) 'Symetrie         ',ii,inb,flumty(ii)
1581
 
#else
1582
 
      write(nfecra,7020) 'Symmetry         ',ii,inb,flumty(ii)
1583
 
#endif
1584
 
 
1585
 
      ii = iindef
1586
 
      inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
1587
 
      if (irangp.ge.0) then
1588
 
        call parcpt (inb)
1589
 
        call parsom (flumty(ii))
1590
 
      endif
1591
 
#if defined(_CS_LANG_FR)
1592
 
      write(nfecra,7020) 'Indefini         ',ii,inb,flumty(ii)
1593
 
#else
1594
 
      write(nfecra,7020) 'Undefined        ',ii,inb,flumty(ii)
1595
 
#endif
1596
 
 
1597
 
      do ii = 1, ntypmx
1598
 
        if (ii.ne.iesicf .and. &
1599
 
            ii.ne.isspcf .and. &
1600
 
            ii.ne.ieqhcf .and. &
1601
 
            ii.ne.ierucf .and. &
1602
 
            ii.ne.isopcf .and. &
1603
 
            ii.ne.iparoi .and. &
1604
 
            ii.ne.isymet .and. &
1605
 
            ii.ne.iindef) then
1606
 
          inb = ifinty(ii,iphas)-idebty(ii,iphas)+1
1607
 
          if (irangp.ge.0) then
1608
 
            call parcpt (inb)
1609
 
            call parsom (flumty(ii))
1610
 
          endif
1611
 
          if(inb.gt.0) then
1612
 
#if defined(_CS_LANG_FR)
1613
 
            write(nfecra,7020) 'Type utilisateur ',ii,inb,flumty(ii)
1614
 
#else
1615
 
            write(nfecra,7020) 'User type        ',ii,inb,flumty(ii)
1616
 
#endif
1617
 
          endif
1618
 
        endif
1619
 
      enddo
1620
 
 
1621
 
    endif
1622
 
 
1623
 
    write(nfecra,7030)
 
1205
if(iwrnp.ge.1 .or. mod(ntcabs,ntlist).eq.0                      &
 
1206
     .or.(ntcabs.le.ntpabs+2).or.(ntcabs.ge.ntmabs-1)) then
 
1207
 
 
1208
  do ii = 1, ntypmx
 
1209
    flumty(ii) = 0.d0
 
1210
  enddo
 
1211
 
 
1212
  do ii = 1, ntypmx
 
1213
    ideb = idebty(ii)
 
1214
    ifin = ifinty(ii)
 
1215
    do jj = ideb, ifin
 
1216
      ifac = itrifb(jj)
 
1217
      flumty(ii) = flumty(ii) + propfb(ifac,iflmab)
 
1218
    enddo
 
1219
  enddo
 
1220
 
 
1221
 
 
1222
  write(nfecra,7011)
 
1223
 
 
1224
  if (ippmod(icompf).lt.0 ) then
 
1225
 
 
1226
    ii = ientre
 
1227
    inb = ifinty(ii)-idebty(ii)+1
 
1228
    if (irangp.ge.0) then
 
1229
      call parcpt (inb)
 
1230
      call parsom (flumty(ii))
 
1231
    endif
 
1232
#if defined(_CS_LANG_FR)
 
1233
    write(nfecra,7020) 'Entree           ',ii,inb,flumty(ii)
 
1234
#else
 
1235
    write(nfecra,7020) 'Inlet            ',ii,inb,flumty(ii)
 
1236
#endif
 
1237
    ii = iparoi
 
1238
    inb = ifinty(ii)-idebty(ii)+1
 
1239
    if (irangp.ge.0) then
 
1240
      call parcpt (inb)
 
1241
      call parsom (flumty(ii))
 
1242
    endif
 
1243
#if defined(_CS_LANG_FR)
 
1244
    write(nfecra,7020) 'Paroi lisse      ',ii,inb,flumty(ii)
 
1245
#else
 
1246
    write(nfecra,7020) 'Smooth wall      ',ii,inb,flumty(ii)
 
1247
#endif
 
1248
    ii = iparug
 
1249
    inb = ifinty(ii)-idebty(ii)+1
 
1250
    if (irangp.ge.0) then
 
1251
      call parcpt (inb)
 
1252
      call parsom (flumty(ii))
 
1253
    endif
 
1254
#if defined(_CS_LANG_FR)
 
1255
    write(nfecra,7020) 'Paroi rugueuse   ',ii,inb,flumty(ii)
 
1256
#else
 
1257
    write(nfecra,7020) 'Rough wall       ',ii,inb,flumty(ii)
 
1258
#endif
 
1259
    ii = isymet
 
1260
    inb = ifinty(ii)-idebty(ii)+1
 
1261
    if (irangp.ge.0) then
 
1262
      call parcpt (inb)
 
1263
      call parsom (flumty(ii))
 
1264
    endif
 
1265
#if defined(_CS_LANG_FR)
 
1266
    write(nfecra,7020) 'Symetrie         ',ii,inb,flumty(ii)
 
1267
#else
 
1268
    write(nfecra,7020) 'Symmetry         ',ii,inb,flumty(ii)
 
1269
#endif
 
1270
 
 
1271
    ii = isolib
 
1272
    inb = ifinty(ii)-idebty(ii)+1
 
1273
    if (irangp.ge.0) then
 
1274
      call parcpt (inb)
 
1275
      call parsom (flumty(ii))
 
1276
    endif
 
1277
#if defined(_CS_LANG_FR)
 
1278
    write(nfecra,7020) 'Sortie libre     ',ii,inb,flumty(ii)
 
1279
#else
 
1280
    write(nfecra,7020) 'Free outlet      ',ii,inb,flumty(ii)
 
1281
#endif
 
1282
 
 
1283
    if (nbrcpl.ge.1) then
 
1284
      ii = icscpl
 
1285
      inb = ifinty(ii)-idebty(ii)+1
 
1286
      if (irangp.ge.0) then
 
1287
        call parcpt (inb)
 
1288
        call parsom (flumty(ii))
 
1289
      endif
 
1290
#if defined(_CS_LANG_FR)
 
1291
      write(nfecra,7020) 'Couplage sat/sat ',ii,inb,flumty(ii)
 
1292
#else
 
1293
      write(nfecra,7020) 'Sat/Sat coupling ',ii,inb,flumty(ii)
 
1294
#endif
 
1295
    endif
 
1296
 
 
1297
    ii = iindef
 
1298
    inb = ifinty(ii)-idebty(ii)+1
 
1299
    if (irangp.ge.0) then
 
1300
      call parcpt (inb)
 
1301
      call parsom (flumty(ii))
 
1302
    endif
 
1303
#if defined(_CS_LANG_FR)
 
1304
    write(nfecra,7020) 'Indefini         ',ii,inb,flumty(ii)
 
1305
#else
 
1306
    write(nfecra,7020) 'Undefined        ',ii,inb,flumty(ii)
 
1307
#endif
 
1308
 
 
1309
    do ii = 1, ntypmx
 
1310
      if ( ii.ne.ientre .and.                                    &
 
1311
           ii.ne.iparoi .and.                                    &
 
1312
           ii.ne.iparug .and.                                    &
 
1313
           ii.ne.isymet .and.                                    &
 
1314
           ii.ne.isolib .and.                                    &
 
1315
           ii.ne.icscpl .and.                                    &
 
1316
           ii.ne.iindef ) then
 
1317
        inb = ifinty(ii)-idebty(ii)+1
 
1318
        if (irangp.ge.0) then
 
1319
          call parcpt (inb)
 
1320
          call parsom (flumty(ii))
 
1321
        endif
 
1322
        if(inb.gt.0) then
 
1323
#if defined(_CS_LANG_FR)
 
1324
          write(nfecra,7020) 'Type utilisateur ',ii,inb,flumty(ii)
 
1325
#else
 
1326
          write(nfecra,7020) 'User type        ',ii,inb,flumty(ii)
 
1327
#endif
 
1328
        endif
 
1329
      endif
 
1330
    enddo
 
1331
 
 
1332
  else
 
1333
 
 
1334
    ii = ieqhcf
 
1335
    inb = ifinty(ii)-idebty(ii)+1
 
1336
    if (irangp.ge.0) then
 
1337
      call parcpt (inb)
 
1338
      call parsom (flumty(ii))
 
1339
    endif
 
1340
#if defined(_CS_LANG_FR)
 
1341
    write(nfecra,7020) 'Entree sub. enth.',ii,inb,flumty(ii)
 
1342
#else
 
1343
    write(nfecra,7020) 'Sub. enth. inlet ',ii,inb,flumty(ii)
 
1344
#endif
 
1345
 
 
1346
    ii = ierucf
 
1347
    inb = ifinty(ii)-idebty(ii)+1
 
1348
    if (irangp.ge.0) then
 
1349
      call parcpt (inb)
 
1350
      call parsom (flumty(ii))
 
1351
    endif
 
1352
#if defined(_CS_LANG_FR)
 
1353
    write(nfecra,7020) 'Entree subsonique',ii,inb,flumty(ii)
 
1354
#else
 
1355
    write(nfecra,7020) 'Subsonic inlet   ',ii,inb,flumty(ii)
 
1356
#endif
 
1357
 
 
1358
    ii = iesicf
 
1359
    inb = ifinty(ii)-idebty(ii)+1
 
1360
    if (irangp.ge.0) then
 
1361
      call parcpt (inb)
 
1362
      call parsom (flumty(ii))
 
1363
    endif
 
1364
#if defined(_CS_LANG_FR)
 
1365
    write(nfecra,7020) 'Entree/Sortie imp',ii,inb,flumty(ii)
 
1366
#else
 
1367
    write(nfecra,7020) 'Imp inlet/outlet ',ii,inb,flumty(ii)
 
1368
#endif
 
1369
 
 
1370
    ii = isopcf
 
1371
    inb = ifinty(ii)-idebty(ii)+1
 
1372
    if (irangp.ge.0) then
 
1373
      call parcpt (inb)
 
1374
      call parsom (flumty(ii))
 
1375
    endif
 
1376
#if defined(_CS_LANG_FR)
 
1377
    write(nfecra,7020) 'Sortie subsonique',ii,inb,flumty(ii)
 
1378
#else
 
1379
    write(nfecra,7020) 'Subsonic outlet  ',ii,inb,flumty(ii)
 
1380
#endif
 
1381
 
 
1382
    ii = isspcf
 
1383
    inb = ifinty(ii)-idebty(ii)+1
 
1384
    if (irangp.ge.0) then
 
1385
      call parcpt (inb)
 
1386
      call parsom (flumty(ii))
 
1387
    endif
 
1388
#if defined(_CS_LANG_FR)
 
1389
    write(nfecra,7020) 'Sortie supersoniq',ii,inb,flumty(ii)
 
1390
#else
 
1391
    write(nfecra,7020) 'Supersonic outlet',ii,inb,flumty(ii)
 
1392
#endif
 
1393
 
 
1394
    ii = iparoi
 
1395
    inb = ifinty(ii)-idebty(ii)+1
 
1396
    if (irangp.ge.0) then
 
1397
      call parcpt (inb)
 
1398
      call parsom (flumty(ii))
 
1399
    endif
 
1400
#if defined(_CS_LANG_FR)
 
1401
    write(nfecra,7020) 'Paroi            ',ii,inb,flumty(ii)
 
1402
#else
 
1403
    write(nfecra,7020) 'Wall             ',ii,inb,flumty(ii)
 
1404
#endif
 
1405
 
 
1406
    ii = isymet
 
1407
    inb = ifinty(ii)-idebty(ii)+1
 
1408
    if (irangp.ge.0) then
 
1409
      call parcpt (inb)
 
1410
      call parsom (flumty(ii))
 
1411
    endif
 
1412
#if defined(_CS_LANG_FR)
 
1413
    write(nfecra,7020) 'Symetrie         ',ii,inb,flumty(ii)
 
1414
#else
 
1415
    write(nfecra,7020) 'Symmetry         ',ii,inb,flumty(ii)
 
1416
#endif
 
1417
 
 
1418
    ii = iindef
 
1419
    inb = ifinty(ii)-idebty(ii)+1
 
1420
    if (irangp.ge.0) then
 
1421
      call parcpt (inb)
 
1422
      call parsom (flumty(ii))
 
1423
    endif
 
1424
#if defined(_CS_LANG_FR)
 
1425
    write(nfecra,7020) 'Indefini         ',ii,inb,flumty(ii)
 
1426
#else
 
1427
    write(nfecra,7020) 'Undefined        ',ii,inb,flumty(ii)
 
1428
#endif
 
1429
 
 
1430
    do ii = 1, ntypmx
 
1431
      if (ii.ne.iesicf .and. &
 
1432
           ii.ne.isspcf .and. &
 
1433
           ii.ne.ieqhcf .and. &
 
1434
           ii.ne.ierucf .and. &
 
1435
           ii.ne.isopcf .and. &
 
1436
           ii.ne.iparoi .and. &
 
1437
           ii.ne.isymet .and. &
 
1438
           ii.ne.iindef) then
 
1439
        inb = ifinty(ii)-idebty(ii)+1
 
1440
        if (irangp.ge.0) then
 
1441
          call parcpt (inb)
 
1442
          call parsom (flumty(ii))
 
1443
        endif
 
1444
        if(inb.gt.0) then
 
1445
#if defined(_CS_LANG_FR)
 
1446
          write(nfecra,7020) 'Type utilisateur ',ii,inb,flumty(ii)
 
1447
#else
 
1448
          write(nfecra,7020) 'User type        ',ii,inb,flumty(ii)
 
1449
#endif
 
1450
        endif
 
1451
      endif
 
1452
    enddo
1624
1453
 
1625
1454
  endif
1626
1455
 
1627
 
enddo
 
1456
  write(nfecra,7030)
1628
1457
 
 
1458
endif
1629
1459
 
1630
1460
!===============================================================================
1631
1461
! FORMATS
1633
1463
 
1634
1464
#if defined(_CS_LANG_FR)
1635
1465
 
1636
 
 1099 format(                                                     &
1637
 
'@                                                            ',/,&
1638
 
'@                                                            ',/,&
1639
 
'@                                                            ',/,&
1640
 
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
1641
 
'@                                                            ',/,&
1642
 
'@ @@ ATTENTION : ARRET LORS DE LA VERIFICATION DES COND. LIM.',/,&
1643
 
'@    =========                                               ',/,&
1644
 
'@    CONDITIONS AUX LIMITES INCORRECTES OU INCOMPLETES       ',/,&
1645
 
'@                                                            ',/,&
1646
 
'@    La valeur du type ITYPFB des conditions aux limites doit',/,&
1647
 
'@      etre superieure ou egale a          1                 ',/,&
1648
 
'@        et inferieure ou egale a ',I10                       ,/,&
1649
 
'@    Une ou plusieurs erreurs sont listees ci-dessus.        ',/,&
1650
 
'@                                                            ',/,&
1651
 
'@    Le calcul ne sera pas execute.                          ',/,&
1652
 
'@                                                            ',/,&
1653
 
'@    Verifier le codage du sous-programme de definition des  ',/,&
1654
 
'@    aux limites.                                            ',/,&
1655
 
'@                                                            ',/,&
1656
 
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
1657
 
'@                                                            ',/)
1658
 
 
1659
 
 2010 format(/,' PHASE  : ',I10)
1660
1466
 2020 format(/,'   IFINTY : ',I10)
1661
1467
 2030 format(/,'   IDEBTY : ',I10)
1662
1468
 2040 format(/,'   ITYPFB : ',I10)
1705
1511
'@    =========                                               ',/,&
1706
1512
'@    PROBLEME DE TRI DES FACES DE BORD                       ',/,&
1707
1513
'@                                                            ',/,&
1708
 
'@    Phase          ',I10                                     ,/,&
1709
1514
'@      nombre de faces classees par type = ',I10              ,/,&
1710
1515
'@      nombre de faces de bord  NFABOR   = ',I10              ,/,&
1711
1516
'@                                                            ',/,&
1721
1526
 '   ** INFORMATIONS SUR LE TYPE DE FACES DE BORD',/,             &
1722
1527
 '      -----------------------------------------',/)
1723
1528
 6011 format (                                                    &
1724
 
'   Phase : ',I4,                                               /,&
1725
1529
'---------------------------------------------------------------',&
1726
1530
'----------',                                                     &
1727
1531
                                                                /,&
1784
1588
 '   ** INFORMATIONS SUR LE FLUX DE MASSE AU BORD',/,             &
1785
1589
 '      -----------------------------------------',/)
1786
1590
 7011 format (                                                    &
1787
 
'   Phase : ',I4,                                               /,&
1788
1591
'---------------------------------------------------------------',&
1789
1592
                                                                /,&
1790
1593
'Type de bord           Code    Nb faces           Flux de masse',&
1797
1600
                                                                /)
1798
1601
 
1799
1602
 8000 format(/,                                                   &
1800
 
'PHASE ',I4,' :                                               ',/,&
1801
1603
'Faces de bord d''entree/sortie libre detectees               ',/,&
1802
1604
'Mise a jour du point de reference pour la pression totale    ',/,&
1803
1605
' XYZP0 = ',E14.5,E14.5,E14.5                  ,/)
1804
1606
 8001 format(/,                                                   &
1805
 
'PHASE ',I4,' :                                               ',/,&
1806
1607
'Faces de bord a Dirichlet de pression impose detectees       ',/,&
1807
1608
'Mise a jour du point de reference pour la pression totale    ',/,&
1808
1609
' XYZP0 = ',E14.5,E14.5,E14.5                  ,/)
1811
1612
 
1812
1613
#else
1813
1614
 
1814
 
 1099 format(                                                     &
1815
 
'@'                                                            ,/,&
1816
 
'@'                                                            ,/,&
1817
 
'@'                                                            ,/,&
1818
 
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
1819
 
'@'                                                            ,/,&
1820
 
'@ @@ WARNING: ABORT BY BOUNDARY CONDITION CHECK'              ,/,&
1821
 
'@    ========'                                                ,/,&
1822
 
'@    INCORRECT OR INCOMPLETE BOUNDARY CONDITIONS'             ,/,&
1823
 
'@'                                                            ,/,&
1824
 
'@    Value of type ITYPFB for boundary conditions must be'    ,/,&
1825
 
'@          greater or equal to          1'                    ,/,&
1826
 
'@      and less than or equal to ', I10                       ,/,&
1827
 
'@    One or more errors are listed above.'                    ,/,&
1828
 
'@'                                                            ,/,&
1829
 
'@    The calculation will not be run.'                        ,/,&
1830
 
'@'                                                            ,/,&
1831
 
'@    Verify the boundary condition definitions in the'        ,/,&
1832
 
'@    appropriate user subroutine.'                            ,/,&
1833
 
'@'                                                            ,/,&
1834
 
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
1835
 
'@'                                                            ,/)
1836
 
 
1837
 
 2010 format(/,' PHASE  : ',I10)
1838
1615
 2020 format(/,'   IFINTY : ',I10)
1839
1616
 2030 format(/,'   IDEBTY : ',I10)
1840
1617
 2040 format(/,'   ITYPFB : ',I10)
1884
1661
'@    ========'                                                ,/,&
1885
1662
'@    PROBLEM WITH ORDERING OF BOUNDARY FACES'                 ,/,&
1886
1663
'@'                                                            ,/,&
1887
 
'@    Phase          ',I10                                     ,/,&
1888
1664
'@      number of faces classified by type = ',I10             ,/,&
1889
1665
'@      number of boundary faces (NFABOR)  = ',I10             ,/,&
1890
1666
'@'                                                            ,/,&
1900
1676
 '   ** INFORMATION ON BOUNDARY FACES TYPE',/,                    &
1901
1677
 '      ----------------------------------',/)
1902
1678
 6011 format (                                                    &
1903
 
'   Phase : ',I4,                                               /,&
1904
1679
'---------------------------------------------------------------',&
1905
1680
'----------',                                                     &
1906
1681
                                                                /,&
1963
1738
 '   ** BOUNDARY MASS FLOW INFORMATION',/,                        &
1964
1739
 '      ------------------------------',/)
1965
1740
 7011 format (                                                    &
1966
 
'   Phase : ',I4,                                               /,&
1967
1741
'---------------------------------------------------------------',&
1968
1742
                                                                /,&
1969
1743
'Boundary type          Code    Nb faces           Mass flow'   , &
1976
1750
                                                                /)
1977
1751
 
1978
1752
 8000 format(/,                                                   &
1979
 
'PHASE ',I4,' :'                                               ,/,&
1980
1753
'Boundary faces with free inlet/outlet detected'               ,/,&
1981
1754
'Update of reference point for total pressure'                 ,/,&
1982
1755
' XYZP0 = ',E14.5,E14.5,E14.5                  ,/)
1983
1756
 8001 format(/,                                                   &
1984
 
'PHASE ',I4,' :'                                               ,/,&
1985
1757
'Boundary faces with pressure Dirichlet condition detected'    ,/,&
1986
1758
'Update of reference point for total pressure'                 ,/,&
1987
1759
' XYZP0 = ',E14.5,E14.5,E14.5                  ,/)