← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/base/csc2cl.f90

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

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/base/csc2cl.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 csc2cl &
29
24
!================
30
25
 
31
 
 ( idbia0 , idbra0 ,                                              &
32
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
33
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
34
 
   nvar   , nscal  , nphas  ,                                     &
 
26
 ( nvar   , nscal  ,                                              &
35
27
   nvcp   , nvcpto , nfbcpl , nfbncp ,                            &
36
 
   nideve , nrdeve , nituse , nrtuse ,                            &
37
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
38
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
39
28
   icodcl , itrifb , itypfb ,                                     &
40
29
   lfbcpl , lfbncp ,                                              &
41
 
   idevel , ituser , ia     ,                                     &
42
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
43
30
   dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
44
31
   coefa  , coefb  , rcodcl ,                                     &
45
 
   w1     , w2     , w3     , w4     , w5     , w6     , coefu  , &
46
 
   rvcpfb , pndcpl , dofcpl ,                                     &
47
 
   rdevel , rtuser , ra     )
 
32
   rvcpfb , pndcpl , dofcpl )
48
33
 
49
34
!===============================================================================
50
 
! FONCTION :
 
35
! Purpose:
51
36
! --------
52
37
 
53
 
!         TRADUCTION DE LA CONDITION ITYPFB(*,*) = ICSCPL
 
38
! Translation of the "itypfb(*, *) = icscpl" condition.
54
39
 
55
40
!-------------------------------------------------------------------------------
56
41
! Arguments
57
42
!__________________.____._____.________________________________________________.
58
43
! name             !type!mode ! role                                           !
59
44
!__________________!____!_____!________________________________________________!
60
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
61
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
62
 
! ndim             ! i  ! <-- ! spatial dimension                              !
63
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
64
 
! ncel             ! i  ! <-- ! number of cells                                !
65
 
! nfac             ! i  ! <-- ! number of interior faces                       !
66
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
67
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
68
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
69
 
! nnod             ! i  ! <-- ! number of vertices                             !
70
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
71
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
72
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
73
45
! nvar             ! i  ! <-- ! total number of variables                      !
74
46
! nscal            ! i  ! <-- ! total number of scalars                        !
75
 
! nphas            ! i  ! <-- ! number of phases                               !
76
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
77
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
78
 
! ifacel(2, nfac)  ! ia ! <-- ! interior faces -> cells connectivity           !
79
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
80
 
! ifmfbr(nfabor)   ! ia ! <-- ! boundary face family numbers                   !
81
 
! ifmcel(ncelet)   ! ia ! <-- ! cell family numbers                            !
82
 
! iprfml           ! ia ! <-- ! property numbers per family                    !
83
 
!  (nfml, nprfml)  !    !     !                                                !
84
 
! ipnfac(nfac+1)   ! ia ! <-- ! interior faces -> vertices index (optional)    !
85
 
! nodfac(lndfac)   ! ia ! <-- ! interior faces -> vertices list (optional)     !
86
 
! ipnfbr(nfabor+1) ! ia ! <-- ! boundary faces -> vertices index (optional)    !
87
 
! nodfbr(lndfbr)   ! ia ! <-- ! boundary faces -> vertices list (optional)     !
88
 
! icodcl           ! te ! --> ! code de condition limites aux faces            !
89
 
!  (nfabor,nvar    !    !     !  de bord                                       !
90
 
!                  !    !     ! = 1   -> dirichlet                             !
91
 
!                  !    !     ! = 3   -> densite de flux                       !
92
 
!                  !    !     ! = 4   -> glissemt et u.n=0 (vitesse)           !
93
 
!                  !    !     ! = 5   -> frottemt et u.n=0 (vitesse)           !
94
 
!                  !    !     ! = 9   -> entree/sortie libre (vitesse          !
95
 
!                  !    !     !  entrante eventuelle     bloquee               !
96
 
!                  !    !     ! = 10  -> entree/sortie libre (vitesse          !
97
 
!                  !    !     !  entrante eventuelle non bloquee :             !
98
 
!                  !    !     !  prescrire une valeur de dirichlet en          !
99
 
!                  !    !     !  prevision pour les scalaires k, eps,          !
100
 
!                  !    !     !  scal en plus du neumann usuel                 !
 
47
! icodcl           ! te ! --> ! boundary condition code at boundary faces      !
 
48
!  (nfabor, nvar)  !    !     ! = 1   -> dirichlet                             !
 
49
!                  !    !     ! = 3   -> flux density                          !
 
50
!                  !    !     ! = 4   -> sliding and u.n=0 (velocity)          !
 
51
!                  !    !     ! = 5   -> friction and u.n=0 (velocity)         !
 
52
!                  !    !     ! = 9   -> free inlet/outlet (inlet velocity     !
 
53
!                  !    !     !  possibly fixed)                               !
 
54
!                  !    !     ! = 10  -> free inlet/outlet (possible inlet     !
 
55
!                  !    !     !  volocity not fixed: prescribe a Dirichlet     !
 
56
!                  !    !     !  value for scalars k, eps, scal in addition to !
 
57
!                  !    !     !  the usual Neumann                             !
101
58
! itrifb           ! ia ! <-- ! indirection for boundary faces ordering        !
102
 
!  (nfabor, nphas) !    !     !                                                !
103
59
! itypfb           ! ia ! --> ! boundary face types                            !
104
 
!  (nfabor, nphas) !    !     !                                                !
105
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
106
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
107
 
! ia(*)            ! ia ! --- ! main integer work array                        !
108
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
109
 
!  (ndim, ncelet)  !    !     !                                                !
110
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
111
 
!  (ndim, nfac)    !    !     !                                                !
112
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
113
 
!  (ndim, nfabor)  !    !     !                                                !
114
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
115
 
!  (ndim, nfac)    !    !     !                                                !
116
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
117
 
!  (ndim, nfabor)  !    !     !                                                !
118
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !
119
 
!  (ndim, nnod)    !    !     !                                                !
120
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !
121
60
! dt(ncelet)       ! ra ! <-- ! time step (per cell)                           !
122
61
! rtp, rtpa        ! ra ! <-- ! calculated variables at cell centers           !
123
62
!  (ncelet, *)     !    !     !  (at current and previous time steps)          !
126
65
! propfb(nfabor, *)! ra ! <-- ! physical properties at boundary face centers   !
127
66
! coefa, coefb     ! ra ! <-- ! boundary conditions                            !
128
67
!  (nfabor, *)     !    !     !                                                !
129
 
! rcodcl           ! tr ! --> ! valeur des conditions aux limites              !
130
 
!  (nfabor,nvar    !    !     !  aux faces de bord                             !
131
 
!                  !    !     ! rcodcl(1) = valeur du dirichlet                !
132
 
!                  !    !     ! rcodcl(2) = valeur du coef. d'echange          !
133
 
!                  !    !     !  ext. (infinie si pas d'echange)               !
134
 
!                  !    !     ! rcodcl(3) = valeur de la densite de            !
135
 
!                  !    !     !  flux (negatif si gain) w/m2                   !
136
 
!                  !    !     ! pour les vitesses (vistl+visct)*gradu          !
137
 
!                  !    !     ! pour la pression             dt*gradp          !
138
 
!                  !    !     ! pour les scalaires                             !
 
68
! rcodcl           ! tr ! --> ! value of boundary conditions at boundary faces !
 
69
!  (nfabor, nvar)  !    !     ! rcodcl(1) = Dirichlet value                    !
 
70
!                  !    !     ! rcodcl(2) = ext. exchange coefficient value    !
 
71
!                  !    !     !  (infinite if no exchange)                     !
 
72
!                  !    !     ! rcodcl(3) = value of the flux density          !
 
73
!                  !    !     !  (negative if gain) in w/m2                    !
 
74
!                  !    !     ! for velocities:   (vistl+visct)*gradu          !
 
75
!                  !    !     ! for pressure:                dt*gradp          !
 
76
!                  !    !     ! for scalars:                                   !
139
77
!                  !    !     !        cp*(viscls+visct/sigmas)*gradt          !
140
 
! w1,2,3,4,5,6     ! ra ! --- ! work arrays                                    !
141
 
!  (ncelet)        !    !     !  (computation of pressure gradient)            !
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                           !
145
78
!__________________!____!_____!________________________________________________!
146
79
 
147
 
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
148
 
!            L (LOGIQUE)   .. ET TYPES COMPOSES (EX : TR TABLEAU REEL)
149
 
!     MODE : <-- donnee, --> resultat, <-> Donnee modifiee
150
 
!            --- tableau de travail
 
80
!     Type: i (integer), r (real), s (string), a (array), l (logical),
 
81
!           and composite types (ex: ra real array)
 
82
!     mode: <-- input, --> output, <-> modifies data, --- work array
 
83
!===============================================================================
 
84
 
 
85
!===============================================================================
 
86
! Module files
 
87
!===============================================================================
 
88
 
 
89
use paramx
 
90
use numvar
 
91
use optcal
 
92
use cstphy
 
93
use cstnum
 
94
use entsor
 
95
use parall
 
96
use period
 
97
use cplsat
 
98
use mesh
 
99
 
151
100
!===============================================================================
152
101
 
153
102
implicit none
154
103
 
155
 
!===============================================================================
156
 
! Common blocks
157
 
!===============================================================================
158
 
 
159
 
include "paramx.h"
160
 
include "pointe.h"
161
 
include "numvar.h"
162
 
include "optcal.h"
163
 
include "cstphy.h"
164
 
include "cstnum.h"
165
 
include "entsor.h"
166
 
include "parall.h"
167
 
include "period.h"
168
 
include "cplsat.h"
169
 
 
170
 
!===============================================================================
171
 
 
172
104
! Arguments
173
105
 
174
 
integer          idbia0 , idbra0
175
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
176
 
integer          nfml   , nprfml
177
 
integer          nnod   , lndfac , lndfbr , ncelbr
178
 
integer          nvar   , nscal  , nphas
179
 
integer          nideve , nrdeve , nituse , nrtuse
 
106
integer          nvar   , nscal
180
107
integer          nvcp   , nvcpto
181
108
integer          nfbcpl , nfbncp
182
109
 
183
 
integer          ifacel(2,nfac)  , ifabor(nfabor)
184
 
integer          ifmfbr(nfabor)  , ifmcel(ncelet)
185
 
integer          iprfml(nfml,nprfml)
186
 
integer          ipnfac(nfac+1)  , nodfac(lndfac)
187
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr)
188
110
integer          icodcl(nfabor,nvar)
189
111
integer          lfbcpl(nfbcpl)  , lfbncp(nfbncp)
190
 
integer          itrifb(nfabor,nphas), itypfb(nfabor,nphas)
191
 
integer          idevel(nideve), ituser(nituse)
192
 
integer          ia(*)
 
112
integer          itrifb(nfabor), itypfb(nfabor)
193
113
 
194
 
double precision xyzcen(ndim,ncelet)
195
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
196
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
197
 
double precision xyznod(ndim,nnod), volume(ncelet)
198
114
double precision dt(ncelet), rtp(ncelet,*), rtpa(ncelet,*)
199
115
double precision propce(ncelet,*)
200
116
double precision propfa(nfac,*), propfb(nfabor,*)
201
117
double precision coefa(nfabor,*), coefb(nfabor,*)
202
118
double precision rcodcl(nfabor,nvar,3)
203
 
double precision w1(ncelet),w2(ncelet),w3(ncelet)
204
 
double precision w4(ncelet),w5(ncelet),w6(ncelet)
205
 
double precision coefu(nfabor,ndim)
206
119
double precision rvcpfb(nfbcpl,nvcpto), pndcpl(nfbcpl)
207
120
double precision dofcpl(3,nfbcpl)
208
 
double precision rdevel(nrdeve), rtuser(nrtuse)
209
 
double precision ra(*)
210
121
 
211
122
! Local variables
212
123
 
213
 
 
214
 
integer          idebia, idebra
215
 
integer          ifac, iel,isou, iphas
216
 
integer          inc, iccocg, iphydp, iclvar, nswrgp, imligp
 
124
integer          ifac, iel,isou
 
125
integer          inc, iccocg, iclvar, nswrgp, imligp
217
126
integer          iwarnp, ivar
218
127
integer          ipt
219
128
integer          iii
227
136
double precision xif, yif, zif, xopf, yopf, zopf
228
137
double precision gradi, pondj, flumab
229
138
 
230
 
!===============================================================================
231
 
 
232
 
 
233
 
idebia = idbia0
234
 
idebra = idbra0
235
 
 
236
 
 
237
 
!================================================================================
238
 
! 1.  TRADUCTION DU COUPLAGE EN TERMES DE CONDITIONS AUX LIMITES
239
 
!================================================================================
240
 
 
241
 
! On rappelle que les variables sont re�ues dans l'ordre de VARPOS ;
242
 
! il suffit dont de boucler sur les variables.
 
139
double precision, allocatable, dimension(:,:) :: grad
 
140
 
 
141
!===============================================================================
 
142
 
 
143
 
 
144
 
 
145
 
 
146
!===============================================================================
 
147
! 1.  Translation of the coupling to boundary conditions
 
148
!===============================================================================
 
149
 
 
150
! Allocate a temporary array for gradient computation
 
151
allocate(grad(ncelet,3))
 
152
 
 
153
! Reminder: variables are received in the order of VARPOS;
 
154
! loopin on variables is thus sufficient.
243
155
 
244
156
do ivar = 1, nvcp
245
157
 
246
 
!   --- Calcul du gradient de la variable si celle-ci est interpol�e
247
 
!         Les �changes pour le parall�lisme et la p�diocit� (PARCOM
248
 
!         et PERCOM) ont d�j� �t� fait dans CSCPFB.
249
 
!         Inutile de les refaire.
 
158
  ! --- Compute gradient of variable if it is interpolated.
 
159
  !       Exchanges for parallelism and periodicity have already been
 
160
  !       done in CSCPFB. Non need to do them again.
250
161
 
251
162
  inc    = 1
252
163
  iccocg = 1
253
 
  iphydp = 0
254
164
 
255
165
  iclvar = iclrtp(ivar,icoef)
256
166
  nswrgp = nswrgr(ivar)
262
172
 
263
173
  call grdcel                                                     &
264
174
  !==========
265
 
 ( idebia , idebra ,                                              &
266
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml,  &
267
 
   nnod   , lndfac , lndfbr , ncelbr , nphas  ,                   &
268
 
   nideve , nrdeve , nituse , nrtuse ,                            &
269
 
   ivar   , imrgra , inc    , iccocg , nswrgp , imligp , iphydp,  &
 
175
 ( ivar   , imrgra , inc    , iccocg , nswrgp , imligp ,          &
270
176
   iwarnp , nfecra ,                                              &
271
177
   epsrgp , climgp , extrap ,                                     &
272
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
273
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
274
 
   idevel , ituser , ia     ,                                     &
275
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume,  &
276
 
   w4     , w4     , w4     ,                                     &
277
178
   rtp(1,ivar) , coefa(1,iclvar) , coefb(1,iclvar) ,              &
278
 
   w1     , w2     , w3     ,                                     &
279
 
!        ------   ------   ------
280
 
   w4     , w5     , w6     ,                                     &
281
 
   rdevel , rtuser , ra     )
 
179
   grad   )
282
180
 
283
181
 
284
182
  ! For a specific face to face coupling, geometric assumptions are made
291
189
      ifac = lfbcpl(ipt)
292
190
      iel  = ifabor(ifac)
293
191
 
294
 
!         Information de l'instance en cours interpol�e en I'
295
 
      iii = idiipb-1+3*(ifac-1)
296
 
      xiip = ra(iii+1)
297
 
      yiip = ra(iii+2)
298
 
      ziip = ra(iii+3)
 
192
      ! Information for current instance interpolated at I'
 
193
      xiip = diipb(1,ifac)
 
194
      yiip = diipb(2,ifac)
 
195
      ziip = diipb(3,ifac)
299
196
 
300
197
      xif = cdgfbo(1,ifac) -xyzcen(1,iel)
301
198
      yif = cdgfbo(2,ifac) -xyzcen(2,iel)
307
204
 
308
205
      ipf = sqrt(xipf**2+yipf**2+zipf**2)
309
206
 
310
 
 
311
 
      iii = idiipb-1+3*(ifac-1)
312
 
      xiip = ra(iii+1)
313
 
      yiip = ra(iii+2)
314
 
      ziip = ra(iii+3)
315
 
 
316
207
      xopf = dofcpl(1,ipt)
317
208
      yopf = dofcpl(2,ipt)
318
209
      zopf = dofcpl(3,ipt)
319
210
 
320
 
      if (ivar.eq.ipr(1)) then
321
 
 
322
 
! --- On veut imposer un dirichlet de pression de mani�re � conserver
323
 
!     le gradient de pression � la travers�e du couplage et �tre consistant
324
 
!     avec la r�solution du gradient de pression sur maillage orthogonal
325
 
 
326
 
        xip = rtp(iel,ivar) + (w1(iel)*xiip + w2(iel)*yiip + w3(iel)*ziip)
327
 
 
328
 
      else if (ivar.eq.iu(1).or.ivar.eq.iv(1).or.ivar.eq.iw(1)) then
329
 
 
330
 
! --- Pour toutes les autres variables, on veut imposer un dirichlet
331
 
!     en accord avec les flux convectifs au centre. On se laisse le choix
332
 
!     entre UPWIND, SOLU et CENTRE. Seul le centr� respecte la diffusion
333
 
!     des faces internes du somaine. Pour l'UPWIND et le SOLU, le d�centrement
334
 
!     est r�alis� ici et plus dans bilsc2.F pour les faces coupl�es.
335
 
 
336
 
! -- UPWIND
337
 
 
338
 
!        xip =  rtp(iel,ivar)
339
 
 
340
 
! -- SOLU
341
 
 
342
 
!        xip =  rtp(iel,ivar) + (w1(iel)*xif + w2(iel)*yif + w3(iel)*zif)
343
 
 
344
 
! -- CENTRE
345
 
 
346
 
        xip =  rtp(iel,ivar) + w1(iel)*xiip + w2(iel)*yiip + w3(iel)*ziip
 
211
      if (ivar.eq.ipr) then
 
212
 
 
213
        ! --- We want to prescribe a Direchlet for pressure so as to conserve
 
214
        !     the pressure gradient through the coupling and remain consistent
 
215
        !     with the resolution of the pressure gradient on an orthogonal mesh.
 
216
 
 
217
        xip = rtp(iel,ivar) &
 
218
            + (grad(iel,1)*xiip + grad(iel,2)*yiip + grad(iel,3)*ziip)
 
219
 
 
220
      else if (ivar.eq.iu.or.ivar.eq.iv.or.ivar.eq.iw) then
 
221
 
 
222
        ! --- For all other variables, we want to prescribe a Dirichlet matching
 
223
        !     the convective fluxes at the center. We resrve a choice between
 
224
        !     UPWIND, SOLU, and CENTERED. Only the centered case respects the diffusion
 
225
        !     at the domain's interior faces. For UPWIND and SOLU, the decentering
 
226
        !     is done here and in bilsc2.f90 for coupled faces.
 
227
 
 
228
        ! -- UPWIND
 
229
 
 
230
        !        xip =  rtp(iel,ivar)
 
231
 
 
232
        ! -- SOLU
 
233
 
 
234
        !        xip =  rtp(iel,ivar) &
 
235
        !            + (grad(iel,1)*xif + grad(iel,2)*yif + grad(iel,3)*zif)
 
236
 
 
237
        ! -- CENTERED
 
238
 
 
239
        xip = rtp(iel,ivar) &
 
240
            + (grad(iel,1)*xiip + grad(iel,2)*yiip + grad(iel,3)*ziip)
347
241
 
348
242
      else
349
243
 
350
 
! -- UPWIND
351
 
 
352
 
!        xip =  rtp(iel,ivar)
353
 
 
354
 
! -- SOLU
355
 
 
356
 
!        xip =  rtp(iel,ivar) + (w1(iel)*xif + w2(iel)*yif + w3(iel)*zif)
357
 
 
358
 
! -- CENTRE
359
 
 
360
 
        xip =  rtp(iel,ivar) + (w1(iel)*xiip + w2(iel)*yiip + w3(iel)*ziip)
 
244
        ! -- UPWIND
 
245
 
 
246
        !        xip =  rtp(iel,ivar)
 
247
 
 
248
        ! -- SOLU
 
249
 
 
250
        !        xip = rtp(iel,ivar) &
 
251
        !            + (grad(iel,1)*xif + grad(iel,2)*yif + grad(iel,3)*zif)
 
252
 
 
253
        ! -- CENTERED
 
254
 
 
255
        xip =  rtp(iel,ivar) &
 
256
            + (grad(iel,1)*xiip + grad(iel,2)*yiip + grad(iel,3)*ziip)
361
257
 
362
258
      endif
363
259
 
364
 
! -- on a besoin de alpha_ij pour interpolation centr�e et du flumab
365
 
!    pour le d�centrement
 
260
      ! -- We need alpha_ij for centered interpolation and flumab for decentering
366
261
 
367
262
      pondj = pndcpl(ipt)
368
 
      flumab = propfb(ifac,ipprob(ifluma(iu(1))))
 
263
      flumab = propfb(ifac,ipprob(ifluma(iu)))
369
264
 
370
 
!         Informations recues de l'instance distante en J'/O'
 
265
      ! Information received from distant instance at J'/O'
371
266
      xjp = rvcpfb(ipt,ivar)
372
267
 
373
268
 
374
 
      do iphas = 1, nphas
375
 
        itypfb(ifac,iphas)  = icscpl
376
 
      enddo
377
 
 
378
 
      if (ivar.eq.ipr(1)) then
379
 
 
380
 
        icodcl(ifac,ivar  ) = 1
381
 
        rcodcl(ifac,ivar,1) = (1.d0-pondj)*xjp + pondj*xip + p0(1)
382
 
 
383
 
      else if (ivar.eq.iu(1).or.ivar.eq.iv(1).or.ivar.eq.iw(1)) then
384
 
 
385
 
        icodcl(ifac,ivar  ) = 1
386
 
 
387
 
! -- DECENTRE (SOLU ou UPWIND)
388
 
 
389
 
!        if (flumab.ge.0.d0) then
390
 
!          rcodcl(ifac,ivar,1) = xip
391
 
!        else
392
 
!          rcodcl(ifac,ivar,1) = xjp
393
 
!        endif
394
 
 
395
 
! -- CENTRE
 
269
      itypfb(ifac)  = icscpl
 
270
 
 
271
      if (ivar.eq.ipr) then
 
272
 
 
273
        icodcl(ifac,ivar  ) = 1
 
274
        rcodcl(ifac,ivar,1) = (1.d0-pondj)*xjp + pondj*xip + p0
 
275
 
 
276
      else if (ivar.eq.iu.or.ivar.eq.iv.or.ivar.eq.iw) then
 
277
 
 
278
        icodcl(ifac,ivar  ) = 1
 
279
 
 
280
        ! -- DECENTERED (SOLU or UPWIND)
 
281
 
 
282
        !        if (flumab.ge.0.d0) then
 
283
        !          rcodcl(ifac,ivar,1) = xip
 
284
        !        else
 
285
        !          rcodcl(ifac,ivar,1) = xjp
 
286
        !        endif
 
287
 
 
288
        ! -- CENTERED
396
289
 
397
290
        rcodcl(ifac,ivar,1) = (1.d0-pondj)*xjp + pondj*xip
398
291
 
400
293
 
401
294
        icodcl(ifac,ivar  ) = 1
402
295
 
403
 
! -- DECENTRE (SOLU ou UPWIND)
404
 
 
405
 
!        if(flumab.ge.0.d0) then
406
 
!          rcodcl(ifac,ivar,1) = xip
407
 
!        else
408
 
!          rcodcl(ifac,ivar,1) = xjp
409
 
!        endif
410
 
 
411
 
! -- CENTRE
 
296
        ! -- DECENTERED (SOLU or UPWIND)
 
297
 
 
298
        !        if(flumab.ge.0.d0) then
 
299
        !          rcodcl(ifac,ivar,1) = xip
 
300
        !        else
 
301
        !          rcodcl(ifac,ivar,1) = xjp
 
302
        !        endif
 
303
 
 
304
        ! -- CENTERED
412
305
 
413
306
        rcodcl(ifac,ivar,1) = (1.d0-pondj)*xjp + pondj*xip
414
307
 
416
309
 
417
310
    enddo
418
311
 
419
 
  ! For a generic coupling, no assumption can be made
 
312
    ! For a generic coupling, no assumption can be made
420
313
 
421
314
  else
422
315
 
423
316
 
424
 
!   --- Traduction en termes de condition limite pour les faces de bord localis�es
425
 
!         --> CL type Dirichlet
 
317
    ! --- Translation in terms of boundary conditions for located boundary faces
 
318
    !     --> Dirichlet BC type
426
319
 
427
320
    do ipt = 1, nfbcpl
428
321
 
429
322
      ifac = lfbcpl(ipt)
430
323
      iel  = ifabor(ifac)
431
324
 
432
 
!         Information de l'instance en cours interpol�e en I'
433
 
      iii = idiipb-1+3*(ifac-1)
434
 
      xiip = ra(iii+1)
435
 
      yiip = ra(iii+2)
436
 
      ziip = ra(iii+3)
 
325
      ! Information from local instance interpolated at I'
 
326
      xiip = diipb(1,ifac)
 
327
      yiip = diipb(2,ifac)
 
328
      ziip = diipb(3,ifac)
437
329
 
438
330
      xif = cdgfbo(1,ifac) -xyzcen(1,iel)
439
331
      yif = cdgfbo(2,ifac) -xyzcen(2,iel)
445
337
 
446
338
      ipf = sqrt(xipf**2+yipf**2+zipf**2)
447
339
 
448
 
 
449
 
      iii = idiipb-1+3*(ifac-1)
450
 
      xiip = ra(iii+1)
451
 
      yiip = ra(iii+2)
452
 
      ziip = ra(iii+3)
453
 
 
454
340
      xopf = dofcpl(1,ipt)
455
341
      yopf = dofcpl(2,ipt)
456
342
      zopf = dofcpl(3,ipt)
457
343
 
458
 
!         Informations locales interpolees en I'/O'
459
 
 
460
 
      xip =  rtp(iel,ivar)                                          &
461
 
        + (w1(iel)*(xiip+xopf) + w2(iel)*(yiip+yopf) +              &
462
 
           w3(iel)*(ziip+zopf))
463
 
 
464
 
!         Informations recues de l'instance distante en J'/O'
 
344
      ! Local information interpolated at I'/O'
 
345
 
 
346
      xip =  rtp(iel,ivar) &
 
347
          + grad(iel,1)*(xiip+xopf) &
 
348
          + grad(iel,2)*(yiip+yopf) &
 
349
          + grad(iel,3)*(ziip+zopf)
 
350
 
 
351
      ! Information received from distant instance at J'/O'
465
352
      xjp = rvcpfb(ipt,ivar)
466
353
 
467
354
 
468
 
      gradi = (w1(iel)*xipf+w2(iel)*yipf+w3(iel)*zipf)/ipf
469
 
 
470
 
      do iphas = 1, nphas
471
 
        itypfb(ifac,iphas)  = icscpl
472
 
      enddo
473
 
 
474
 
      if(ivar.ne.ipr(1)) then
 
355
      gradi = (grad(iel,1)*xipf+grad(iel,2)*yipf+grad(iel,3)*zipf)/ipf
 
356
 
 
357
      itypfb(ifac)  = icscpl
 
358
 
 
359
      if(ivar.ne.ipr) then
475
360
        icodcl(ifac,ivar  ) = 1
476
361
        rcodcl(ifac,ivar,1) = 0.5d0*(xip+xjp)
477
362
      else
484
369
 
485
370
  endif
486
371
 
487
 
! --- Faces de bord non localis�es
488
 
!       --> CL type Neumann homog�ne
 
372
  ! --- Non-located boundary faces
 
373
  !     --> Homogeneous Neuman BC type
489
374
 
490
375
  do ipt = 1, nfbncp
491
376
 
492
377
    ifac = lfbncp(ipt)
493
378
 
494
 
    do iphas = 1, nphas
495
 
      itypfb(ifac,iphas)  = icscpl
496
 
    enddo
 
379
    itypfb(ifac)  = icscpl
497
380
 
498
381
    icodcl(ifac,ivar  ) = 3
499
382
    rcodcl(ifac,ivar,3) = 0.d0
502
385
 
503
386
enddo
504
387
 
505
 
 
506
 
!----
507
 
! FORMAT
508
 
!----
509
 
 
510
 
!----
511
 
! FIN
 
388
! Free memory
 
389
deallocate(grad)
 
390
 
 
391
!----
 
392
! Formats
 
393
!----
 
394
 
 
395
!----
 
396
! End
512
397
!----
513
398
 
514
399
return