← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/base/cscfbr.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/cscfbr.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 cscfbr &
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
   icodcl , itrifb , itypfb ,                                     &
39
 
   idevel , ituser , ia    ,                                      &
40
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
41
28
   dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
42
 
   coefa  , coefb  , rcodcl ,                                     &
43
 
   w1     , w2     , w3     , w4     , w5     , w6     , coefu  , &
44
 
   rdevel , rtuser , ra     )
 
29
   coefa  , coefb  , rcodcl )
45
30
 
46
31
!===============================================================================
47
32
! FONCTION :
55
40
!__________________.____._____.________________________________________________.
56
41
! name             !type!mode ! role                                           !
57
42
!__________________!____!_____!________________________________________________!
58
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
59
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
60
 
! ndim             ! i  ! <-- ! spatial dimension                              !
61
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
62
 
! ncel             ! i  ! <-- ! number of cells                                !
63
 
! nfac             ! i  ! <-- ! number of interior faces                       !
64
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
65
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
66
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
67
 
! nnod             ! i  ! <-- ! number of vertices                             !
68
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
69
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
70
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
71
43
! nvar             ! i  ! <-- ! total number of variables                      !
72
44
! nscal            ! i  ! <-- ! total number of scalars                        !
73
 
! nphas            ! i  ! <-- ! number of phases                               !
74
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
75
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
76
45
! ivar             ! i  ! <-- ! variable number                                !
77
 
! ifacel(2, nfac)  ! ia ! <-- ! interior faces -> cells connectivity           !
78
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
79
 
! ifmfbr(nfabor)   ! ia ! <-- ! boundary face family numbers                   !
80
 
! ifmcel(ncelet)   ! ia ! <-- ! cell family numbers                            !
81
 
! iprfml           ! ia ! <-- ! property numbers per family                    !
82
 
!  (nfml, nprfml)  !    !     !                                                !
83
 
! ipnfac(nfac+1)   ! ia ! <-- ! interior faces -> vertices index (optional)    !
84
 
! nodfac(lndfac)   ! ia ! <-- ! interior faces -> vertices list (optional)     !
85
 
! ipnfbr(nfabor+1) ! ia ! <-- ! boundary faces -> vertices index (optional)    !
86
 
! nodfbr(lndfbr)   ! ia ! <-- ! boundary faces -> vertices list (optional)     !
87
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
88
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
89
 
! ia(*)            ! ia ! --- ! main integer work array                        !
90
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
91
 
!  (ndim, ncelet)  !    !     !                                                !
92
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
93
 
!  (ndim, nfac)    !    !     !                                                !
94
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
95
 
!  (ndim, nfabor)  !    !     !                                                !
96
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
97
 
!  (ndim, nfac)    !    !     !                                                !
98
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
99
 
!  (ndim, nfabor)  !    !     !                                                !
100
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !
101
 
!  (ndim, nnod)    !    !     !                                                !
102
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !
103
46
! dt(ncelet)       ! ra ! <-- ! time step (per cell)                           !
104
47
! rtpa             ! tr ! <-- ! variables de calcul au centre des              !
105
48
! (ncelet,*)       !    !     !    cellules (instant            prec)          !
110
53
!  (nfabor, *)     !    !     !                                                !
111
54
! crvexp(ncelet    ! tr ! --> ! tableau de travail pour part explicit          !
112
55
! crvimp(ncelet    ! tr ! --> ! tableau de travail pour part implicit          !
113
 
! dam(ncelet       ! tr ! --- ! tableau de travail pour matrice                !
114
 
! xam(nfac,*)      ! tr ! --- ! tableau de travail pour matrice                !
115
 
! w1...6(ncelet    ! tr ! --- ! tableau de travail                             !
116
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
117
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
118
 
! ra(*)            ! ra ! --- ! main real work array                           !
119
56
!__________________!____!_____!________________________________________________!
120
57
 
121
58
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
122
59
!            L (LOGIQUE)   .. ET TYPES COMPOSES (EX : TR TABLEAU REEL)
123
60
!     MODE : <-- donnee, --> resultat, <-> Donnee modifiee
124
61
!            --- tableau de travail
125
 
!-------------------------------------------------------------------------------
 
62
!===============================================================================
 
63
 
 
64
!===============================================================================
 
65
! Module files
 
66
!===============================================================================
 
67
 
 
68
use paramx
 
69
use numvar
 
70
use entsor
 
71
use optcal
 
72
use cstphy
 
73
use cstnum
 
74
use parall
 
75
use period
 
76
use cplsat
 
77
use mesh
 
78
 
126
79
!===============================================================================
127
80
 
128
81
implicit none
129
82
 
130
 
!===============================================================================
131
 
! Common blocks
132
 
!===============================================================================
133
 
 
134
 
include "paramx.h"
135
 
include "pointe.h"
136
 
include "numvar.h"
137
 
include "entsor.h"
138
 
include "optcal.h"
139
 
include "cstphy.h"
140
 
include "cstnum.h"
141
 
include "parall.h"
142
 
include "period.h"
143
 
include "cplsat.h"
144
 
 
145
 
!===============================================================================
146
 
 
147
83
! Arguments
148
84
 
149
 
integer          idbia0 , idbra0
150
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
151
 
integer          nfml   , nprfml
152
 
integer          nnod   , lndfac , lndfbr , ncelbr
153
 
integer          nvar   , nscal  , nphas
154
 
integer          nideve , nrdeve , nituse , nrtuse
 
85
integer          nvar   , nscal
155
86
 
156
 
integer          ifacel(2,nfac)  , ifabor(nfabor)
157
 
integer          ifmfbr(nfabor)  , ifmcel(ncelet)
158
 
integer          iprfml(nfml,nprfml)
159
 
integer          ipnfac(nfac+1)  , nodfac(lndfac)
160
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr)
161
87
integer          icodcl(nfabor,nvar)
162
 
integer          itrifb(nfabor,nphas), itypfb(nfabor,nphas)
163
 
integer          idevel(nideve), ituser(nituse), ia(*)
 
88
integer          itrifb(nfabor), itypfb(nfabor)
164
89
 
165
 
double precision xyzcen(ndim,ncelet)
166
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
167
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
168
 
double precision xyznod(ndim,nnod), volume(ncelet)
169
90
double precision dt(ncelet), rtp(ncelet,*), rtpa(ncelet,*)
170
91
double precision propce(ncelet,*)
171
92
double precision propfa(nfac,*), propfb(nfabor,*)
172
93
double precision coefa(nfabor,*), coefb(nfabor,*)
173
94
double precision rcodcl(nfabor,nvar,3)
174
 
double precision w1(ncelet),w2(ncelet),w3(ncelet)
175
 
double precision w4(ncelet),w5(ncelet),w6(ncelet)
176
 
double precision coefu(nfabor,ndim)
177
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
178
95
 
179
96
! Local variables
180
97
 
181
 
integer          idebia , idebra , ifinia , ifinra
182
98
integer          numcpl , ivarcp
183
99
integer          ncesup , nfbsup
184
100
integer          ncecpl , nfbcpl , ncencp , nfbncp
185
101
integer          ncedis , nfbdis
186
102
integer          nfbcpg , nfbdig
187
 
integer          ilcesu , ilfbsu
188
 
integer          ilcecp , ilfbcp , ilcenc , ilfbnc
189
 
integer          ilocpt , icoopt , idjppt , ipndpt , idofpt
190
 
integer          irvdis , irvfbr , ipndcp , idofcp
191
103
integer          ityloc , ityvar
192
104
 
193
 
!====================================================================================
194
 
 
195
 
idebia = idbia0
196
 
idebra = idbra0
 
105
integer, allocatable, dimension(:) :: lcecpl , lfbcpl , lcencp , lfbncp
 
106
integer, allocatable, dimension(:) :: locpts
 
107
 
 
108
double precision, allocatable, dimension(:,:) :: coopts , djppts , dofpts
 
109
double precision, allocatable, dimension(:,:) :: dofcpl
 
110
double precision, allocatable, dimension(:) :: pndpts
 
111
double precision, allocatable, dimension(:) :: pndcpl
 
112
double precision, allocatable, dimension(:,:) :: rvdis , rvfbr
 
113
 
 
114
!===============================================================================
 
115
 
197
116
 
198
117
do numcpl = 1, nbrcpl
199
118
 
200
 
!======================================================================================
 
119
!===============================================================================
201
120
! 1.  DEFINITION DE CHAQUE COUPLAGE
202
 
!======================================================================================
 
121
!===============================================================================
203
122
 
204
123
  call nbecpl                                                     &
205
124
  !==========
207
126
   ncesup , nfbsup ,                                              &
208
127
   ncecpl , nfbcpl , ncencp , nfbncp )
209
128
 
210
 
  call memcs1                                                     &
211
 
  !==========
212
 
 ( idebia , idebra ,                                              &
213
 
   ncesup , nfbsup , ncecpl , nfbcpl , ncencp , nfbncp ,          &
214
 
   ilcesu , ilfbsu , ilcecp , ilfbcp , ilcenc , ilfbnc ,          &
215
 
   ifinia , ifinra )
 
129
  ! Allocate temporary arrays for coupling information
 
130
  allocate(lcecpl(ncecpl), lcencp(ncencp))
 
131
  allocate(lfbcpl(nfbcpl), lfbncp(nfbncp))
216
132
 
217
133
!       Liste des cellules et faces de bord localis�es
218
134
  call lelcpl                                                     &
219
135
  !==========
220
136
 ( numcpl ,                                                       &
221
137
   ncecpl , nfbcpl ,                                              &
222
 
   ia(ilcecp) , ia(ilfbcp) )
 
138
   lcecpl , lfbcpl )
223
139
 
224
140
!       Liste des cellules et faces de bord non localis�es
225
141
  call lencpl                                                     &
226
142
  !==========
227
143
 ( numcpl ,                                                       &
228
144
   ncencp , nfbncp ,                                              &
229
 
   ia(ilcenc) , ia(ilfbnc) )
230
 
 
231
 
 
232
 
!====================================================================================
 
145
   lcencp , lfbncp )
 
146
 
 
147
  ! Free memory
 
148
  deallocate(lcecpl, lcencp)
 
149
 
 
150
!===============================================================================
233
151
! 2.  PREPARATION DES VARIABLES A ENVOYER SUR LES FACES DE BORD
234
 
!====================================================================================
 
152
!===============================================================================
235
153
 
236
154
  ityvar = 2
237
155
 
240
158
  call npdcpl(numcpl, ncedis, nfbdis)
241
159
  !==========
242
160
 
243
 
  call memcs2                                                     &
244
 
  !==========
245
 
 ( ifinia , ifinra ,                                              &
246
 
   nfbcpl , nfbdis , nvarto(numcpl) ,                             &
247
 
   irvfbr , ipndcp , idofcp ,                                     &
248
 
   irvdis , ilocpt , icoopt , idjppt , idofpt , ipndpt ,          &
249
 
   ifinia , ifinra )
250
 
 
251
 
  call coocpl(numcpl, nfbdis, ityvar,                             &
252
 
  !==========
253
 
              ityloc, ia(ilocpt), ra(icoopt),                     &
254
 
              ra(idjppt), ra(idofpt), ra(ipndpt))
 
161
  ! Allocate temporary arrays for geometric quantities
 
162
  allocate(locpts(nfbdis))
 
163
  allocate(coopts(3,nfbdis), djppts(3,nfbdis), dofpts(3,nfbdis))
 
164
  allocate(pndpts(nfbdis))
 
165
 
 
166
  ! Allocate temporary arrays for variables exchange
 
167
  allocate(rvdis(nfbdis,nvarto(numcpl)))
 
168
  allocate(rvfbr(nfbcpl,nvarto(numcpl)))
 
169
 
 
170
  call coocpl &
 
171
  !==========
 
172
( numcpl , nfbdis , ityvar , &
 
173
  ityloc , locpts , coopts , &
 
174
  djppts , dofpts , pndpts )
255
175
 
256
176
  if (ityloc.eq.2) then
257
177
    write(nfecra,1000)
277
197
 
278
198
    call cscpfb                                                   &
279
199
    !==========
280
 
  ( ifinia , ifinra ,                                             &
281
 
    ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml, &
282
 
    nnod   , lndfac , lndfbr , ncelbr ,                           &
283
 
    nvar   , nscal  , nphas  ,                                    &
 
200
  ( nvar   , nscal  ,                                             &
284
201
    nfbdis , ityloc , nvarcp(numcpl) , numcpl ,                   &
285
202
    nvarto(numcpl) ,                                              &
286
 
    nideve , nrdeve , nituse , nrtuse ,                           &
287
 
    ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                  &
288
 
    ipnfac , nodfac , ipnfbr , nodfbr ,                           &
289
 
    ia(ilocpt) ,                                                  &
290
 
    idevel , ituser , ia     ,                                    &
291
 
    xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume ,&
 
203
    locpts ,                                                      &
292
204
    dt     , rtp    , rtpa   , propce , propfa , propfb ,         &
293
205
    coefa  , coefb  ,                                             &
294
 
    w1     , w2     , w3     , w4     , w5     , w6     ,         &
295
 
    ra(icoopt)      , ra(idjppt)      , ra(ipndpt)      ,         &
296
 
    ra(irvdis)      , ra(idofpt)      ,                           &
297
 
    rdevel , rtuser , ra     )
 
206
    coopts , djppts , pndpts ,                                    &
 
207
    rvdis  , dofpts )
298
208
 
299
209
  endif
300
210
 
 
211
  ! Free memory
 
212
  deallocate(locpts)
 
213
  deallocate(coopts, djppts, dofpts)
 
214
  deallocate(pndpts)
 
215
 
301
216
!       Cet appel est sym�trique, donc on teste sur NFBDIG et NFBCPG
302
217
!       (rien a envoyer, rien a recevoir)
303
218
  if (nfbdig.gt.0.or.nfbcpg.gt.0) then
304
219
 
305
220
    do ivarcp = 1, nvarto(numcpl)
306
221
 
307
 
      call varcpl                                                 &
 
222
      call varcpl &
308
223
      !==========
309
 
    ( numcpl , nfbdis , nfbcpl , ityvar ,                         &
310
 
      ra(irvdis + (ivarcp-1)*nfbdis) ,                            &
311
 
      ra(irvfbr + (ivarcp-1)*nfbcpl) )
 
224
    ( numcpl , nfbdis , nfbcpl , ityvar , &
 
225
      rvdis(1, ivarcp) ,             &
 
226
      rvfbr(1, ivarcp) )
312
227
 
313
228
    enddo
314
229
 
315
230
  endif
316
231
 
 
232
  ! Free memory
 
233
  deallocate(rvdis)
317
234
 
318
 
!====================================================================================
 
235
!===============================================================================
319
236
! 3.  TRADUCTION DU COUPLAGE EN TERME DE CONDITIONS AUX LIMITES
320
 
!====================================================================================
 
237
!===============================================================================
321
238
 
322
239
  if (nfbcpg.gt.0) then
323
240
 
324
 
    call pndcpl                                                   &
325
 
    !==========
326
 
  ( numcpl , nfbcpl , ityvar , ra(ipndcp) , ra(idofcp) )
327
 
 
328
 
    call csc2cl                                                   &
329
 
    !==========
330
 
  ( ifinia , ifinra ,                                             &
331
 
    ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml ,&
332
 
    nnod   , lndfac , lndfbr , ncelbr ,                           &
333
 
    nvar   , nscal  , nphas  ,                                    &
 
241
    ! Allocate temporary arrays for geometric quantities
 
242
    allocate(dofcpl(3,nfbcpl))
 
243
    allocate(pndcpl(nfbcpl))
 
244
 
 
245
    call pondcp &
 
246
    !==========
 
247
  ( numcpl , nfbcpl , ityvar , pndcpl , dofcpl )
 
248
 
 
249
    call csc2cl &
 
250
    !==========
 
251
  ( nvar   , nscal  ,                                             &
334
252
    nvarcp(numcpl), nvarto(numcpl) , nfbcpl , nfbncp ,            &
335
 
    nideve , nrdeve , nituse , nrtuse ,                           &
336
 
    ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                  &
337
 
    ipnfac , nodfac , ipnfbr , nodfbr ,                           &
338
253
    icodcl , itrifb , itypfb ,                                    &
339
 
    ia(ilfbcp) , ia(ilfbnc) ,                                     &
340
 
    idevel , ituser , ia     ,                                    &
341
 
    xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume ,&
 
254
    lfbcpl , lfbncp ,                                             &
342
255
    dt     , rtp    , rtpa   , propce , propfa , propfb ,         &
343
256
    coefa  , coefb  , rcodcl ,                                    &
344
 
    w1     , w2     , w3     , w4     , w5     , w6     , coefu  ,&
345
 
    ra(irvfbr)      , ra(ipndcp)      , ra(idofcp)      ,         &
346
 
    rdevel , rtuser , ra     )
 
257
    rvfbr  , pndcpl , dofcpl )
 
258
 
 
259
    ! Free memory
 
260
    deallocate(dofcpl, pndcpl)
347
261
 
348
262
  endif
349
263
 
 
264
  ! Free memory
 
265
  deallocate(rvfbr)
 
266
  deallocate(lfbcpl, lfbncp)
 
267
 
350
268
enddo
351
269
!     Fin de la boucle sur les couplages
352
270