← Back to branch summary

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

« back to all changes in this revision

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