~ubuntu-branches/ubuntu/oneiric/code-saturne/oneiric

« back to all changes in this revision

Viewing changes to src/base/tsepdc.f90

  • Committer: Bazaar Package Importer
  • Author(s): Sylvestre Ledru
  • Date: 2009-11-02 23:21:17 UTC
  • Revision ID: james.westby@ubuntu.com-20091102232117-9brxj2l5e33ie45a
Tags: upstream-2.0.0.beta2
ImportĀ upstreamĀ versionĀ 2.0.0.beta2

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
!-------------------------------------------------------------------------------
 
2
 
 
3
!     This file is part of the Code_Saturne Kernel, element of the
 
4
!     Code_Saturne CFD tool.
 
5
 
 
6
!     Copyright (C) 1998-2008 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
 
25
 
 
26
!-------------------------------------------------------------------------------
 
27
 
 
28
subroutine tsepdc &
 
29
!================
 
30
 
 
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 ,                            &
 
38
   icepdc ,                                                       &
 
39
   idevel , ituser , ia     ,                                     &
 
40
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
41
   rtpa   , propce , propfa , propfb ,                            &
 
42
   coefa  , coefb  , ckupdc , trav   ,                            &
 
43
   w1     , w2     , w3     , w4     , w5     , w6     ,          &
 
44
   rdevel , rtuser , ra     )
 
45
 
 
46
!===============================================================================
 
47
! FONCTION :
 
48
! ----------
 
49
 
 
50
! CALCUL DES TERMES DE PERTE DE CHARGE
 
51
!        POUR LE BILAN EXPLICITE
 
52
!-------------------------------------------------------------------------------
 
53
!ARGU                             ARGUMENTS
 
54
!__________________.____._____.________________________________________________.
 
55
!    nom           !type!mode !                   role                         !
 
56
!__________________!____!_____!________________________________________________!
 
57
! idbia0           ! e  ! <-- ! numero de la 1ere case libre dans ia           !
 
58
! idbra0           ! e  ! <-- ! numero de la 1ere case libre dans ra           !
 
59
! ndim             ! e  ! <-- ! dimension de l'espace                          !
 
60
! ncelet           ! e  ! <-- ! nombre d'elements halo compris                 !
 
61
! ncel             ! e  ! <-- ! nombre d'elements actifs                       !
 
62
! nfac             ! e  ! <-- ! nombre de faces internes                       !
 
63
! nfabor           ! e  ! <-- ! nombre de faces de bord                        !
 
64
! nfml             ! e  ! <-- ! nombre de familles d entites                   !
 
65
! nprfml           ! e  ! <-- ! nombre de proprietese des familles             !
 
66
! nnod             ! e  ! <-- ! nombre de sommets                              !
 
67
! lndfac           ! e  ! <-- ! longueur du tableau nodfac (optionnel          !
 
68
! lndfbr           ! e  ! <-- ! longueur du tableau nodfbr (optionnel          !
 
69
! ncelbr           ! e  ! <-- ! nombre d'elements ayant au moins une           !
 
70
!                  !    !     ! face de bord                                   !
 
71
! nvar             ! e  ! <-- ! nombre total de variables                      !
 
72
! nscal            ! e  ! <-- ! nombre total de scalaires                      !
 
73
! nphas            ! e  ! <-- ! nombre de phases                               !
 
74
! ncepdp           ! e  ! <-- ! nombre de cellules avec pdc                    !
 
75
! nideve nrdeve    ! e  ! <-- ! longueur de idevel rdevel                      !
 
76
! nituse nrtuse    ! e  ! <-- ! longueur de ituser rtuser                      !
 
77
! iphas            ! e  ! <-- ! numero de phase courante                       !
 
78
! idiaex           ! e  ! <-- ! indicateur de traitement de la                 !
 
79
!                  !    !     ! diagonale (=1) ou extradiagonale (=2)          !
 
80
! ifacel           ! te ! <-- ! elements voisins d'une face interne            !
 
81
! (2, nfac)        !    !     !                                                !
 
82
! ifabor           ! te ! <-- ! element  voisin  d'une face de bord            !
 
83
! (nfabor)         !    !     !                                                !
 
84
! ifmfbr           ! te ! <-- ! numero de famille d'une face de bord           !
 
85
! (nfabor)         !    !     !                                                !
 
86
! ifmcel           ! te ! <-- ! numero de famille d'une cellule                !
 
87
! (ncelet)         !    !     !                                                !
 
88
! iprfml           ! te ! <-- ! proprietes d'une famille                       !
 
89
! nfml  ,nprfml    !    !     !                                                !
 
90
! ipnfac           ! te ! <-- ! position du premier noeud de chaque            !
 
91
!   (lndfac)       !    !     !  face interne dans nodfac (optionnel)          !
 
92
! nodfac           ! te ! <-- ! connectivite faces internes/noeuds             !
 
93
!   (nfac+1)       !    !     !  (optionnel)                                   !
 
94
! ipnfbr           ! te ! <-- ! position du premier noeud de chaque            !
 
95
!   (lndfbr)       !    !     !  face de bord dans nodfbr (optionnel)          !
 
96
! nodfbr           ! te ! <-- ! connectivite faces de bord/noeuds              !
 
97
!   (nfabor+1)     !    !     !  (optionnel)                                   !
 
98
! icepdc(ncelet    ! te ! <-- ! numero des ncepdp cellules avec pdc            !
 
99
! idevel(nideve    ! te ! <-- ! tab entier complementaire developemt           !
 
100
! ituser(nituse    ! te ! <-- ! tab entier complementaire utilisateur          !
 
101
! ia(*)            ! tr ! --- ! macro tableau entier                           !
 
102
! xyzcen           ! tr ! <-- ! point associes aux volumes de control          !
 
103
! (ndim,ncelet     !    !     !                                                !
 
104
! surfac           ! tr ! <-- ! vecteur surface des faces internes             !
 
105
! (ndim,nfac)      !    !     !                                                !
 
106
! surfbo           ! tr ! <-- ! vecteur surface des faces de bord              !
 
107
! (ndim,nfabor)    !    !     !                                                !
 
108
! cdgfac           ! tr ! <-- ! centre de gravite des faces internes           !
 
109
! (ndim,nfac)      !    !     !                                                !
 
110
! cdgfbo           ! tr ! <-- ! centre de gravite des faces de bord            !
 
111
! (ndim,nfabor)    !    !     !                                                !
 
112
! xyznod           ! tr ! <-- ! coordonnes des noeuds (optionnel)              !
 
113
! (ndim,nnod)      !    !     !                                                !
 
114
! volume           ! tr ! <-- ! volume d'un des ncelet elements                !
 
115
! (ncelet          !    !     !                                                !
 
116
! rtpa             ! tr ! <-- ! variables de calcul au centre des              !
 
117
! (ncelet,*)       !    !     !    cellules (instant prec)                     !
 
118
! propce           ! tr ! <-- ! proprietes physiques au centre des             !
 
119
! (ncelet,*)       !    !     !    cellules                                    !
 
120
! propfa           ! tr ! <-- ! proprietes physiques au centre des             !
 
121
!  (nfac,*)        !    !     !    faces internes                              !
 
122
! propfb           ! tr ! <-- ! proprietes physiques au centre des             !
 
123
!  (nfabor,*)      !    !     !    faces de bord                               !
 
124
! coefa, coefb     ! tr ! <-- ! conditions aux limites aux                     !
 
125
!  (nfabor,*)      !    !     !    faces de bord                               !
 
126
! ckupdc           ! tr ! <-- ! tableau de travail pour pdc                    !
 
127
!  (ncepdp,6)      !    !     !                                                !
 
128
! w1...6(ncelet    ! tr ! --- ! tableau de travail                             !
 
129
! trav(ncelet,3    ! tr ! <-- ! tableau des second membres                     !
 
130
! rdevel(nrdeve    ! tr ! <-- ! tab reel complementaire developemt             !
 
131
! rtuser(nrtuse    ! tr ! <-- ! tab reel complementaire utilisateur            !
 
132
! ra(*)            ! tr ! --- ! macro tableau reel                             !
 
133
!__________________!____!_____!________________________________________________!
 
134
 
 
135
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
 
136
!            L (LOGIQUE)   .. ET TYPES COMPOSES (EX : TR TABLEAU REEL)
 
137
!     MODE : <-- donnee, --> resultat, <-> Donnee modifiee
 
138
!            --- tableau de travail
 
139
 
 
140
!===============================================================================
 
141
 
 
142
implicit none
 
143
 
 
144
!===============================================================================
 
145
!     DONNEES EN COMMON
 
146
!===============================================================================
 
147
 
 
148
include "paramx.h"
 
149
include "numvar.h"
 
150
include "optcal.h"
 
151
 
 
152
!===============================================================================
 
153
 
 
154
! Arguments
 
155
 
 
156
integer          idbia0 , idbra0
 
157
integer          ndim   , ncelet , ncel   , nfac   , nfabor
 
158
integer          nfml   , nprfml
 
159
integer          nnod   , lndfac , lndfbr , ncelbr
 
160
integer          nvar   , nscal  , nphas
 
161
integer          ncepdp
 
162
integer          nideve , nrdeve , nituse , nrtuse , iphas
 
163
integer          idiaex
 
164
 
 
165
integer          ifacel(2,nfac) , ifabor(nfabor)
 
166
integer          ifmfbr(nfabor) , ifmcel(ncelet)
 
167
integer          iprfml(nfml,nprfml)
 
168
integer          ipnfac(nfac+1), nodfac(lndfac)
 
169
integer          ipnfbr(nfabor+1), nodfbr(lndfbr)
 
170
integer          icepdc(ncepdp)
 
171
integer          idevel(nideve), ituser(nituse), ia(*)
 
172
 
 
173
double precision xyzcen(ndim,ncelet)
 
174
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
 
175
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
 
176
double precision xyznod(ndim,nnod), volume(ncelet)
 
177
double precision rtpa(ncelet,*)
 
178
double precision propce(ncelet,*)
 
179
double precision propfa(nfac,*), propfb(nfabor,*)
 
180
double precision coefa(nfabor,*), coefb(nfabor,*)
 
181
double precision ckupdc(ncepdp,6)
 
182
double precision w1(ncelet),w2(ncelet),w3(ncelet)
 
183
double precision w4(ncelet),w5(ncelet),w6(ncelet)
 
184
double precision trav(ncelet,3)
 
185
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
 
186
 
 
187
! VARIABLES LOCALES
 
188
 
 
189
integer          idebia, idebra
 
190
integer          iel   , ielpdc
 
191
integer          iuiph , iviph , iwiph , ipcrom, ipcroo
 
192
double precision romvom, vit1  , vit2  , vit3
 
193
double precision cpdc11, cpdc22, cpdc33, cpdc12, cpdc13, cpdc23
 
194
 
 
195
!===============================================================================
 
196
 
 
197
idebia = idbia0
 
198
idebra = idbra0
 
199
 
 
200
iuiph  = iu(iphas)
 
201
iviph  = iv(iphas)
 
202
iwiph  = iw(iphas)
 
203
ipcrom = ipproc(irom  (iphas))
 
204
 
 
205
ipcroo = ipcrom
 
206
if(iroext(iphas).gt.0.and.isno2t(iphas).gt.0) then
 
207
  ipcroo = ipproc(iroma (iphas))
 
208
endif
 
209
 
 
210
!     La diagonale est toujours "implicite"
 
211
 
 
212
if(idiaex.eq.1) then
 
213
 
 
214
  do ielpdc = 1, ncepdp
 
215
 
 
216
    iel    = icepdc(ielpdc)
 
217
    romvom =-propce(iel,ipcrom)*volume(iel)
 
218
    cpdc11 = ckupdc(ielpdc,1)
 
219
    cpdc22 = ckupdc(ielpdc,2)
 
220
    cpdc33 = ckupdc(ielpdc,3)
 
221
    vit1   = rtpa(iel,iuiph)
 
222
    vit2   = rtpa(iel,iviph)
 
223
    vit3   = rtpa(iel,iwiph)
 
224
 
 
225
    trav(iel,1) = trav(iel,1) +                                   &
 
226
         romvom * ( cpdc11*vit1                             )
 
227
    trav(iel,2) = trav(iel,2) +                                   &
 
228
         romvom * (               cpdc22*vit2               )
 
229
    trav(iel,3) = trav(iel,3) +                                   &
 
230
         romvom * (                             cpdc33*vit3 )
 
231
 
 
232
  enddo
 
233
 
 
234
endif
 
235
 
 
236
!     L'extradiagonale est explicite mais peut etre extrapolee
 
237
 
 
238
if(idiaex.eq.2) then
 
239
 
 
240
  do ielpdc = 1, ncepdp
 
241
 
 
242
    iel    = icepdc(ielpdc)
 
243
    romvom =-propce(iel,ipcroo)*volume(iel)
 
244
    cpdc12 = ckupdc(ielpdc,4)
 
245
    cpdc13 = ckupdc(ielpdc,5)
 
246
    cpdc23 = ckupdc(ielpdc,6)
 
247
    vit1   = rtpa(iel,iuiph)
 
248
    vit2   = rtpa(iel,iviph)
 
249
    vit3   = rtpa(iel,iwiph)
 
250
 
 
251
    trav(iel,1) = trav(iel,1) +                                   &
 
252
         romvom * (               cpdc12*vit2 + cpdc13*vit3 )
 
253
    trav(iel,2) = trav(iel,2) +                                   &
 
254
         romvom * ( cpdc12*vit1               + cpdc23*vit3 )
 
255
    trav(iel,3) = trav(iel,3) +                                   &
 
256
         romvom * ( cpdc13*vit1 + cpdc23*vit2               )
 
257
 
 
258
  enddo
 
259
 
 
260
endif
 
261
 
 
262
 
 
263
return
 
264
 
 
265
end