← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/pprt/ppprcl.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/pprt/ppprcl.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 ppprcl &
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 , izfppp ,                                              &
39
 
   idevel , ituser , ia     ,                                     &
40
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
41
28
   dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
42
29
   coefa  , coefb  ,                                              &
43
 
   rcodcl , coefu  ,                                              &
44
 
   w1     , w2     , w3     , w4     , w5     , w6     ,          &
45
 
   rdevel , rtuser , ra     )
 
30
   rcodcl )
46
31
 
47
32
!===============================================================================
48
33
! FONCTION :
58
43
!__________________.____._____.________________________________________________.
59
44
! name             !type!mode ! role                                           !
60
45
!__________________!____!_____!________________________________________________!
61
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
62
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
63
 
! ndim             ! i  ! <-- ! spatial dimension                              !
64
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
65
 
! ncel             ! i  ! <-- ! number of cells                                !
66
 
! nfac             ! i  ! <-- ! number of interior faces                       !
67
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
68
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
69
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
70
 
! nnod             ! i  ! <-- ! number of vertices                             !
71
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
72
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
73
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
74
46
! nvar             ! i  ! <-- ! total number of variables                      !
75
47
! nscal            ! i  ! <-- ! total number of scalars                        !
76
 
! nphas            ! i  ! <-- ! number of phases                               !
77
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
78
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
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
! icodcl           ! te ! --> ! code de condition limites aux faces            !
90
49
!  (nfabor,nvar    !    !     !  de bord                                       !
91
50
!                  !    !     ! = 1   -> dirichlet                             !
97
56
!                  !    !     !  entrante eventuelle     bloquee               !
98
57
! izfppp           ! te ! --> ! numero de zone de la face de bord              !
99
58
! (nfabor)         !    !     !  pour le module phys. part.                    !
100
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
101
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
102
 
! ia(*)            ! ia ! --- ! main integer work array                        !
103
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
104
 
!  (ndim, ncelet)  !    !     !                                                !
105
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
106
 
!  (ndim, nfac)    !    !     !                                                !
107
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
108
 
!  (ndim, nfabor)  !    !     !                                                !
109
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
110
 
!  (ndim, nfac)    !    !     !                                                !
111
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
112
 
!  (ndim, nfabor)  !    !     !                                                !
113
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !
114
 
!  (ndim, nnod)    !    !     !                                                !
115
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !
116
59
! dt(ncelet)       ! ra ! <-- ! time step (per cell)                           !
117
60
! rtp, rtpa        ! ra ! <-- ! calculated variables at cell centers           !
118
61
!  (ncelet, *)     !    !     !  (at current and previous time steps)          !
133
76
!                  !    !     ! pour la pression             dt*gradp          !
134
77
!                  !    !     ! pour les scalaires                             !
135
78
!                  !    !     !        cp*(viscls+visct/sigmas)*gradt          !
136
 
! coefu            ! tr ! --- ! tab de trav                                    !
137
 
!  nfabor,3        !    !     !  (vitesse en i'                 )              !
138
 
! w1,2,3,4,5,6     ! ra ! --- ! work arrays                                    !
139
 
!  (ncelet)        !    !     !  (computation of pressure gradient)            !
140
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
141
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
142
 
! ra(*)            ! ra ! --- ! main real work array                           !
143
79
!__________________!____!_____!________________________________________________!
144
80
 
145
81
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
148
84
!            --- tableau de travail
149
85
!===============================================================================
150
86
 
 
87
!===============================================================================
 
88
! Module files
 
89
!===============================================================================
 
90
 
 
91
use paramx
 
92
use numvar
 
93
use optcal
 
94
use cstphy
 
95
use cstnum
 
96
use entsor
 
97
use ppppar
 
98
use ppthch
 
99
use coincl
 
100
use cpincl
 
101
use cs_fuel_incl
 
102
use ppincl
 
103
use cfpoin
 
104
use atincl
 
105
use mesh
 
106
 
 
107
!===============================================================================
 
108
 
151
109
implicit none
152
110
 
153
 
!===============================================================================
154
 
! Common blocks
155
 
!===============================================================================
156
 
 
157
 
include "paramx.h"
158
 
include "numvar.h"
159
 
include "optcal.h"
160
 
include "cstphy.h"
161
 
include "cstnum.h"
162
 
include "entsor.h"
163
 
include "pointe.h"
164
 
include "ppppar.h"
165
 
include "ppthch.h"
166
 
include "coincl.h"
167
 
include "cpincl.h"
168
 
include "fuincl.h"
169
 
include "ppincl.h"
170
 
include "cfpoin.h"
171
 
include "atincl.h"
172
 
 
173
 
!===============================================================================
174
 
 
175
111
! Arguments
176
112
 
177
 
integer          idbia0 , idbra0
178
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
179
 
integer          nfml   , nprfml
180
 
integer          nnod   , lndfac , lndfbr , ncelbr
181
 
integer          nvar   , nscal  , nphas
182
 
integer          nideve , nrdeve , nituse , nrtuse
 
113
integer          nvar   , nscal
183
114
 
184
 
integer          ifacel(2,nfac) , ifabor(nfabor)
185
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
186
 
integer          iprfml(nfml,nprfml)
187
 
integer          ipnfac(nfac+1), nodfac(lndfac)
188
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr)
189
115
integer          icodcl(nfabor,nvar)
190
116
integer          izfppp(nfabor)
191
 
integer          idevel(nideve), ituser(nituse), ia(*)
192
117
 
193
 
double precision xyzcen(ndim,ncelet)
194
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
195
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
196
 
double precision xyznod(ndim,nnod), volume(ncelet)
197
118
double precision dt(ncelet), rtp(ncelet,*), rtpa(ncelet,*)
198
119
double precision propce(ncelet,*)
199
120
double precision propfa(nfac,*), propfb(nfabor,*)
200
121
double precision coefa(nfabor,*), coefb(nfabor,*)
201
122
double precision rcodcl(nfabor,nvar,3)
202
 
double precision coefu(nfabor,3)
203
 
double precision w1(ncelet),w2(ncelet),w3(ncelet)
204
 
double precision w4(ncelet),w5(ncelet),w6(ncelet)
205
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
206
123
 
207
124
! Local variables
208
125
 
209
 
integer          idebia, idebra
210
126
integer          ifac, izone, icha, iclapc
211
 
integer          iphas, ivar
 
127
integer          ivar
212
128
 
213
129
!===============================================================================
214
130
!===============================================================================
215
131
! 1.  INITIALISATIONS
216
132
!===============================================================================
217
133
 
218
 
idebia = idbia0
219
 
idebra = idbra0
220
134
 
221
135
! ---> Combustion gaz USEBUC
222
136
!      Flamme de diffusion : chimie 3 points
285
199
    izfppp(ifac) = 0
286
200
  enddo
287
201
 
 
202
elseif ( ippmod(iccoal).ge.0 ) then
 
203
 
 
204
  do izone = 1, nozppm
 
205
    iqimp(izone)  = 0
 
206
    icalke(izone) = 0
 
207
    ientcp(izone) = 0
 
208
    ientat(izone) = 0
 
209
    dh(izone)     = zero
 
210
    xintur(izone) = zero
 
211
    qimpat(izone) = zero
 
212
    timpat(izone) = zero
 
213
    do icha = 1, ncharm
 
214
      qimpcp(izone,icha) = zero
 
215
      timpcp(izone,icha) = zero
 
216
      do iclapc = 1, ncpcmx
 
217
        distch(izone,icha,iclapc) = zero
 
218
      enddo
 
219
    enddo
 
220
  enddo
 
221
 
 
222
  do ifac = 1, nfabor
 
223
    izfppp(ifac) = 0
 
224
  enddo
 
225
 
288
226
! ---> Combustion charbon pulverise couple Lagrangien USCPLC
289
227
 
290
228
elseif ( ippmod(icpl3c).ge.0 ) then
338
276
 
339
277
!     Marqueur d'utilisation de Rusanov au bord (0 = non)
340
278
!     Marqueur de flux conductif impose au bord (0 = non)
341
 
  do iphas = 1, nphas
342
 
    do ifac = 1, nfabor
343
 
      ia(iifbru+ifac-1+(iphas-1)*nfabor) = 0
344
 
      ia(iifbet+ifac-1+(iphas-1)*nfabor) = 0
345
 
    enddo
 
279
  do ifac = 1, nfabor
 
280
    ifbrus(ifac) = 0
 
281
    ifbet(ifac) = 0
346
282
  enddo
347
283
 
348
284
!     Flux de Rusanov au bord pour Qdm et E
349
 
  do iphas = 1, nphas
350
 
    do ifac = 1, nfabor
351
 
      propfb(ifac,ipprob(ifbrhu(iphas))) = 0.d0
352
 
      propfb(ifac,ipprob(ifbrhv(iphas))) = 0.d0
353
 
      propfb(ifac,ipprob(ifbrhw(iphas))) = 0.d0
354
 
      propfb(ifac,ipprob(ifbene(iphas))) = 0.d0
355
 
    enddo
 
285
  do ifac = 1, nfabor
 
286
    propfb(ifac,ipprob(ifbrhu)) = 0.d0
 
287
    propfb(ifac,ipprob(ifbrhv)) = 0.d0
 
288
    propfb(ifac,ipprob(ifbrhw)) = 0.d0
 
289
    propfb(ifac,ipprob(ifbene)) = 0.d0
356
290
  enddo
357
291
 
358
292
!     Initialisation des RCODCL(IFAC,.,1) � -RINFIN