← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/base/recvmc.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/recvmc.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 recvmc &
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 ,                            &
38
 
   idevel , ituser , ia     ,                                     &
39
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
26
 ( nvar   , nscal  ,                                              &
40
27
   rom    , flumas , flumab ,                                     &
41
28
   ux     , uy     , uz     ,                                     &
42
 
   bx     , by     , bz     , cocg   ,                            &
43
 
   rdevel , rtuser , ra     )
 
29
   bx     , by     , bz     )
44
30
 
45
31
!===============================================================================
46
32
! FONCTION :
54
40
!__________________.____._____.________________________________________________.
55
41
! name             !type!mode ! role                                           !
56
42
!__________________!____!_____!________________________________________________!
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
43
! nvar             ! i  ! <-- ! total number of variables                      !
71
44
! 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
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
86
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
87
 
! ia(*)            ! ia ! --- ! main integer work array                        !
88
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
89
 
!  (ndim, ncelet)  !    !     !                                                !
90
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
91
 
!  (ndim, nfac)    !    !     !                                                !
92
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
93
 
!  (ndim, nfabor)  !    !     !                                                !
94
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
95
 
!  (ndim, nfac)    !    !     !                                                !
96
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
97
 
!  (ndim, nfabor)  !    !     !                                                !
98
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !
99
 
!  (ndim, nnod)    !    !     !                                                !
100
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !
101
45
! rom(ncelet       ! tr ! <-- ! masse volumique aux cellules                   !
102
46
! flumas(nfac)     ! tr ! <-- ! flux de masse aux faces internes               !
103
47
! flumab(nfabor    ! tr ! <-- ! flux de masse aux faces de bord                !
104
48
! ux   uy          ! tr ! --> ! vitesse reconstruite                           !
105
49
! uz   (ncelet     ! tr !     !                                                !
106
50
! bx,y,z(ncelet    ! tr ! --- ! tableau de travail                             !
107
 
! cocg             ! tr ! --- ! tableau de travail                             !
108
 
!   (ncelet,3,3    !    !     !                                                !
109
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
110
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
111
 
! ra(*)            ! ra ! --- ! main real work array                           !
112
51
!__________________!____!_____!________________________________________________!
113
52
 
114
53
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
115
54
!            L (LOGIQUE)   .. ET TYPES COMPOSES (EX : TR TABLEAU REEL)
116
55
!     MODE : <-- donnee, --> resultat, <-> Donnee modifiee
117
56
!            --- tableau de travail
118
 
!-------------------------------------------------------------------------------
 
57
!===============================================================================
 
58
 
 
59
!===============================================================================
 
60
! Module files
 
61
!===============================================================================
 
62
 
 
63
use parall
 
64
use mesh
 
65
 
119
66
!===============================================================================
120
67
 
121
68
implicit none
122
69
 
123
 
!===============================================================================
124
 
! Common blocks
125
 
!===============================================================================
126
 
 
127
 
include "vector.h"
128
 
 
129
 
!===============================================================================
130
 
 
131
70
! Arguments
132
71
 
133
 
integer          idbia0 , idbra0
134
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
135
 
integer          nfml   , nprfml
136
 
integer          nnod   , lndfac , lndfbr , ncelbr
137
 
integer          nvar   , nscal  , nphas
138
 
integer          nideve , nrdeve , nituse , nrtuse
139
 
 
140
 
integer          ifacel(2,nfac) , ifabor(nfabor)
141
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
142
 
integer          iprfml(nfml,nprfml)
143
 
integer          ipnfac(nfac+1), nodfac(lndfac)
144
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr)
145
 
integer          idevel(nideve), ituser(nituse), ia(*)
146
 
 
147
 
double precision xyzcen(ndim,ncelet)
148
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
149
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
150
 
double precision xyznod(ndim,nnod), volume(ncelet)
 
72
integer          nvar   , nscal
 
73
 
 
74
 
151
75
double precision rom(ncelet)
152
76
double precision flumas(nfac), flumab(nfabor)
153
77
double precision ux  (ncelet), uy  (ncelet), uz  (ncelet)
154
78
double precision bx(ncelet),   by(ncelet),   bz(ncelet)
155
 
double precision cocg(ncelet,3,3)
156
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
157
79
 
158
80
! Local variables
159
81
 
160
82
integer          lbloc
161
83
parameter       (lbloc = 1024)
162
84
 
163
 
integer          idebia, idebra, ii, jj, iel, ifac
 
85
integer          ii, jj, iel, ifac
164
86
integer          ibloc, nbloc, irel, idim1, idim2
165
87
double precision aa(lbloc,3,3)
166
88
double precision a11, a22, a33, a12, a13, a23, unsdet
169
91
double precision smbx, smby, smbz, unsrho
170
92
double precision vecfac, pfacx, pfacy, pfacz
171
93
 
 
94
double precision, allocatable, dimension(:,:,:) :: cocg
 
95
 
172
96
!===============================================================================
173
97
 
174
 
idebia = idbia0
175
 
idebra = idbra0
176
98
 
177
99
!===============================================================================
178
100
! 1. CALCUL DE LA MATRICE
179
101
!===============================================================================
180
102
 
 
103
! Allocate a temporary array
 
104
allocate(cocg(ncelet,3,3))
 
105
 
181
106
!   INITIALISATION
182
107
 
183
108
do ii = 1, 3
193
118
do idim1 = 1, 3
194
119
  do idim2 = idim1, 3
195
120
 
196
 
    if (ivecti.eq.1) then
197
 
 
198
 
!CDIR NODEP
199
 
      do ifac = 1, nfac
200
 
        ii = ifacel(1,ifac)
201
 
        jj = ifacel(2,ifac)
202
 
        vecfac = surfac(idim1,ifac)*surfac(idim2,ifac)
203
 
        cocg(ii,idim1,idim2) = cocg(ii,idim1,idim2) + vecfac
204
 
        cocg(jj,idim1,idim2) = cocg(jj,idim1,idim2) + vecfac
205
 
      enddo
206
 
 
207
 
    else
208
 
 
209
 
! VECTORISATION NON FORCEE
210
 
      do ifac = 1, nfac
211
 
        ii = ifacel(1,ifac)
212
 
        jj = ifacel(2,ifac)
213
 
        vecfac = surfac(idim1,ifac)*surfac(idim2,ifac)
214
 
        cocg(ii,idim1,idim2) = cocg(ii,idim1,idim2) + vecfac
215
 
        cocg(jj,idim1,idim2) = cocg(jj,idim1,idim2) + vecfac
216
 
      enddo
217
 
 
218
 
    endif
219
 
 
220
 
    if (ivectb.eq.1) then
221
 
 
222
 
!CDIR NODEP
223
 
      do ifac = 1, nfabor
224
 
        ii = ifabor(ifac)
225
 
        cocg(ii,idim1,idim2) = cocg(ii,idim1,idim2)               &
226
 
                         + surfbo(idim1,ifac)*surfbo(idim2,ifac)
227
 
      enddo
228
 
 
229
 
    else
230
 
 
231
 
! VECTORISATION NON FORCEE
232
 
      do ifac = 1, nfabor
233
 
        ii = ifabor(ifac)
234
 
        cocg(ii,idim1,idim2) = cocg(ii,idim1,idim2)               &
235
 
                         + surfbo(idim1,ifac)*surfbo(idim2,ifac)
236
 
      enddo
237
 
 
238
 
    endif
 
121
    do ifac = 1, nfac
 
122
      ii = ifacel(1,ifac)
 
123
      jj = ifacel(2,ifac)
 
124
      vecfac = surfac(idim1,ifac)*surfac(idim2,ifac)
 
125
      cocg(ii,idim1,idim2) = cocg(ii,idim1,idim2) + vecfac
 
126
      cocg(jj,idim1,idim2) = cocg(jj,idim1,idim2) + vecfac
 
127
    enddo
 
128
 
 
129
    do ifac = 1, nfabor
 
130
      ii = ifabor(ifac)
 
131
      cocg(ii,idim1,idim2) = cocg(ii,idim1,idim2)               &
 
132
                          + surfbo(idim1,ifac)*surfbo(idim2,ifac)
 
133
    enddo
239
134
 
240
135
  enddo
241
136
enddo
370
265
 
371
266
!     ASSEMBLAGE A PARTIR DES FACETTES FLUIDES
372
267
 
373
 
if (ivecti.eq.1) then
374
 
 
375
 
!CDIR NODEP
376
 
  do ifac = 1,nfac
377
 
    ii = ifacel(1,ifac)
378
 
    jj = ifacel(2,ifac)
379
 
    pfacx = flumas(ifac)*surfac(1,ifac)
380
 
    pfacy = flumas(ifac)*surfac(2,ifac)
381
 
    pfacz = flumas(ifac)*surfac(3,ifac)
382
 
    bx(ii) = bx(ii) + pfacx
383
 
    by(ii) = by(ii) + pfacy
384
 
    bz(ii) = bz(ii) + pfacz
385
 
    bx(jj) = bx(jj) + pfacx
386
 
    by(jj) = by(jj) + pfacy
387
 
    bz(jj) = bz(jj) + pfacz
388
 
  enddo
389
 
 
390
 
else
391
 
 
392
 
! VECTORISATION NON FORCEE
393
 
  do ifac = 1,nfac
394
 
    ii = ifacel(1,ifac)
395
 
    jj = ifacel(2,ifac)
396
 
    pfacx = flumas(ifac)*surfac(1,ifac)
397
 
    pfacy = flumas(ifac)*surfac(2,ifac)
398
 
    pfacz = flumas(ifac)*surfac(3,ifac)
399
 
    bx(ii) = bx(ii) + pfacx
400
 
    by(ii) = by(ii) + pfacy
401
 
    bz(ii) = bz(ii) + pfacz
402
 
    bx(jj) = bx(jj) + pfacx
403
 
    by(jj) = by(jj) + pfacy
404
 
    bz(jj) = bz(jj) + pfacz
405
 
  enddo
406
 
 
407
 
endif
 
268
do ifac = 1,nfac
 
269
  ii = ifacel(1,ifac)
 
270
  jj = ifacel(2,ifac)
 
271
  pfacx = flumas(ifac)*surfac(1,ifac)
 
272
  pfacy = flumas(ifac)*surfac(2,ifac)
 
273
  pfacz = flumas(ifac)*surfac(3,ifac)
 
274
  bx(ii) = bx(ii) + pfacx
 
275
  by(ii) = by(ii) + pfacy
 
276
  bz(ii) = bz(ii) + pfacz
 
277
  bx(jj) = bx(jj) + pfacx
 
278
  by(jj) = by(jj) + pfacy
 
279
  bz(jj) = bz(jj) + pfacz
 
280
enddo
408
281
 
409
282
 
410
283
!     ASSEMBLAGE A PARTIR DES FACETTES DE BORD
411
284
 
412
 
if (ivectb.eq.1) then
413
 
 
414
 
!CDIR NODEP
415
 
  do ifac = 1,nfabor
416
 
    ii = ifabor(ifac)
417
 
    bx(ii) = bx(ii) + flumab(ifac)*surfbo(1,ifac)
418
 
    by(ii) = by(ii) + flumab(ifac)*surfbo(2,ifac)
419
 
    bz(ii) = bz(ii) + flumab(ifac)*surfbo(3,ifac)
420
 
  enddo
421
 
 
422
 
else
423
 
 
424
 
! VECTORISATION NON FORCEE
425
 
  do ifac = 1,nfabor
426
 
    ii = ifabor(ifac)
427
 
    bx(ii) = bx(ii) + flumab(ifac)*surfbo(1,ifac)
428
 
    by(ii) = by(ii) + flumab(ifac)*surfbo(2,ifac)
429
 
    bz(ii) = bz(ii) + flumab(ifac)*surfbo(3,ifac)
430
 
  enddo
431
 
 
432
 
endif
 
285
do ifac = 1,nfabor
 
286
  ii = ifabor(ifac)
 
287
  bx(ii) = bx(ii) + flumab(ifac)*surfbo(1,ifac)
 
288
  by(ii) = by(ii) + flumab(ifac)*surfbo(2,ifac)
 
289
  bz(ii) = bz(ii) + flumab(ifac)*surfbo(3,ifac)
 
290
enddo
433
291
 
434
292
!===============================================================================
435
293
! 4. RESOLUTION
449
307
              +cocg(iel,3,3)*smbz)*unsrho
450
308
enddo
451
309
 
 
310
! Free memory
 
311
deallocate(cocg)
 
312
 
452
313
!----
453
314
! FIN
454
315
!----