← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/base/tsepdc.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/tsepdc.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 tsepdc &
29
24
!================
30
25
 
31
 
 ( idbia0 , idbra0 ,                                              &
32
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
33
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
34
 
   nvar   , nscal  , nphas  , ncepdp ,                            &
35
 
   nideve , nrdeve , nituse , nrtuse , iphas  , idiaex ,          &
36
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
37
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
 
26
 ( nvar   , nscal  , ncepdp ,                                     &
 
27
   idiaex ,                                                       &
38
28
   icepdc ,                                                       &
39
 
   idevel , ituser , ia     ,                                     &
40
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
41
29
   rtpa   , propce , propfa , propfb ,                            &
42
 
   coefa  , coefb  , ckupdc , trav   ,                            &
43
 
   w1     , w2     , w3     , w4     , w5     , w6     ,          &
44
 
   rdevel , rtuser , ra     )
 
30
   coefa  , coefb  , ckupdc , trav   )
45
31
 
46
32
!===============================================================================
47
33
! 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
45
! ncepdp           ! i  ! <-- ! number of cells with head loss                 !
74
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
75
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
76
 
! iphas            ! i  ! <-- ! phase number                                   !
77
46
! idiaex           ! e  ! <-- ! indicateur de traitement de la                 !
78
47
!                  !    !     ! diagonale (=1) ou extradiagonale (=2)          !
79
 
! ifacel(2, nfac)  ! ia ! <-- ! interior faces -> cells connectivity           !
80
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
81
 
! ifmfbr(nfabor)   ! ia ! <-- ! boundary face family numbers                   !
82
 
! ifmcel(ncelet)   ! ia ! <-- ! cell family numbers                            !
83
 
! iprfml           ! ia ! <-- ! property numbers per family                    !
84
 
!  (nfml, nprfml)  !    !     !                                                !
85
 
! ipnfac(nfac+1)   ! ia ! <-- ! interior faces -> vertices index (optional)    !
86
 
! nodfac(lndfac)   ! ia ! <-- ! interior faces -> vertices list (optional)     !
87
 
! ipnfbr(nfabor+1) ! ia ! <-- ! boundary faces -> vertices index (optional)    !
88
 
! nodfbr(lndfbr)   ! ia ! <-- ! boundary faces -> vertices list (optional)     !
89
48
! icepdc(ncelet    ! te ! <-- ! numero des ncepdp cellules avec pdc            !
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
49
! rtpa             ! tr ! <-- ! variables de calcul au centre des              !
107
50
! (ncelet,*)       !    !     !    cellules (instant prec)                     !
108
51
! propce(ncelet, *)! ra ! <-- ! physical properties at cell centers            !
112
55
!  (nfabor, *)     !    !     !                                                !
113
56
! ckupdc           ! tr ! <-- ! tableau de travail pour pdc                    !
114
57
!  (ncepdp,6)      !    !     !                                                !
115
 
! w1...6(ncelet    ! tr ! --- ! tableau de travail                             !
116
58
! trav(ncelet,3    ! tr ! <-- ! tableau des second membres                     !
117
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
118
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
119
 
! ra(*)            ! ra ! --- ! main real work array                           !
120
59
!__________________!____!_____!________________________________________________!
121
60
 
122
61
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
123
62
!            L (LOGIQUE)   .. ET TYPES COMPOSES (EX : TR TABLEAU REEL)
124
63
!     MODE : <-- donnee, --> resultat, <-> Donnee modifiee
125
64
!            --- tableau de travail
 
65
!===============================================================================
 
66
 
 
67
!===============================================================================
 
68
! Module files
 
69
!===============================================================================
 
70
 
 
71
use paramx
 
72
use numvar
 
73
use optcal
 
74
use mesh
126
75
 
127
76
!===============================================================================
128
77
 
129
78
implicit none
130
79
 
131
 
!===============================================================================
132
 
! Common blocks
133
 
!===============================================================================
134
 
 
135
 
include "paramx.h"
136
 
include "numvar.h"
137
 
include "optcal.h"
138
 
 
139
 
!===============================================================================
140
 
 
141
80
! Arguments
142
81
 
143
 
integer          idbia0 , idbra0
144
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
145
 
integer          nfml   , nprfml
146
 
integer          nnod   , lndfac , lndfbr , ncelbr
147
 
integer          nvar   , nscal  , nphas
 
82
integer          nvar   , nscal
148
83
integer          ncepdp
149
 
integer          nideve , nrdeve , nituse , nrtuse , iphas
150
84
integer          idiaex
151
85
 
152
 
integer          ifacel(2,nfac) , ifabor(nfabor)
153
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
154
 
integer          iprfml(nfml,nprfml)
155
 
integer          ipnfac(nfac+1), nodfac(lndfac)
156
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr)
157
86
integer          icepdc(ncepdp)
158
 
integer          idevel(nideve), ituser(nituse), ia(*)
159
87
 
160
 
double precision xyzcen(ndim,ncelet)
161
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
162
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
163
 
double precision xyznod(ndim,nnod), volume(ncelet)
164
88
double precision rtpa(ncelet,*)
165
89
double precision propce(ncelet,*)
166
90
double precision propfa(nfac,*), propfb(nfabor,*)
167
91
double precision coefa(nfabor,*), coefb(nfabor,*)
168
92
double precision ckupdc(ncepdp,6)
169
 
double precision w1(ncelet),w2(ncelet),w3(ncelet)
170
 
double precision w4(ncelet),w5(ncelet),w6(ncelet)
171
93
double precision trav(ncelet,3)
172
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
173
94
 
174
95
! Local variables
175
96
 
176
 
integer          idebia, idebra
177
97
integer          iel   , ielpdc
178
 
integer          iuiph , iviph , iwiph , ipcrom, ipcroo
 
98
integer          ipcrom, ipcroo
179
99
double precision romvom, vit1  , vit2  , vit3
180
100
double precision cpdc11, cpdc22, cpdc33, cpdc12, cpdc13, cpdc23
181
101
 
182
102
!===============================================================================
183
103
 
184
 
idebia = idbia0
185
 
idebra = idbra0
186
104
 
187
 
iuiph  = iu(iphas)
188
 
iviph  = iv(iphas)
189
 
iwiph  = iw(iphas)
190
 
ipcrom = ipproc(irom  (iphas))
 
105
ipcrom = ipproc(irom  )
191
106
 
192
107
ipcroo = ipcrom
193
 
if(iroext(iphas).gt.0.and.isno2t(iphas).gt.0) then
194
 
  ipcroo = ipproc(iroma (iphas))
 
108
if(iroext.gt.0.and.isno2t.gt.0) then
 
109
  ipcroo = ipproc(iroma )
195
110
endif
196
111
 
197
112
!     La diagonale est toujours "implicite"
205
120
    cpdc11 = ckupdc(ielpdc,1)
206
121
    cpdc22 = ckupdc(ielpdc,2)
207
122
    cpdc33 = ckupdc(ielpdc,3)
208
 
    vit1   = rtpa(iel,iuiph)
209
 
    vit2   = rtpa(iel,iviph)
210
 
    vit3   = rtpa(iel,iwiph)
 
123
    vit1   = rtpa(iel,iu)
 
124
    vit2   = rtpa(iel,iv)
 
125
    vit3   = rtpa(iel,iw)
211
126
 
212
127
    trav(iel,1) = trav(iel,1) +                                   &
213
128
         romvom * ( cpdc11*vit1                             )
231
146
    cpdc12 = ckupdc(ielpdc,4)
232
147
    cpdc13 = ckupdc(ielpdc,5)
233
148
    cpdc23 = ckupdc(ielpdc,6)
234
 
    vit1   = rtpa(iel,iuiph)
235
 
    vit2   = rtpa(iel,iviph)
236
 
    vit3   = rtpa(iel,iwiph)
 
149
    vit1   = rtpa(iel,iu)
 
150
    vit2   = rtpa(iel,iv)
 
151
    vit3   = rtpa(iel,iw)
237
152
 
238
153
    trav(iel,1) = trav(iel,1) +                                   &
239
154
         romvom * (               cpdc12*vit2 + cpdc13*vit3 )