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

« back to all changes in this revision

Viewing changes to src/pprt/ppinv2.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:
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 ppinv2 &
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 , maxelt , lstelt , &
37
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
38
 
   idevel , ituser , ia     ,                                     &
39
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
40
 
   dt     , rtp    , propce , propfa , propfb , coefa  , coefb  , &
41
 
   rdevel , rtuser , ra     )
 
26
 ( nvar   , nscal  ,                                              &
 
27
   dt     , rtp    , propce , propfa , propfb , coefa  , coefb  )
42
28
 
43
29
!===============================================================================
44
30
! FONCTION :
65
51
!     PROPCE (prop au centre), PROPFA (aux faces internes),
66
52
!     PROPFB (prop aux faces de bord)
67
53
!     Ainsi,
68
 
!      PROPCE(IEL,IPPROC(IROM  (IPHAS))) designe ROM   (IEL ,IPHAS)
69
 
!      PROPCE(IEL,IPPROC(IVISCL(IPHAS))) designe VISCL (IEL ,IPHAS)
70
 
!      PROPCE(IEL,IPPROC(ICP   (IPHAS))) designe CP    (IEL ,IPHAS)
 
54
!      PROPCE(IEL,IPPROC(IROM  )) designe ROM   (IEL)
 
55
!      PROPCE(IEL,IPPROC(IVISCL)) designe VISCL (IEL)
 
56
!      PROPCE(IEL,IPPROC(ICP   )) designe CP    (IEL)
71
57
!      PROPCE(IEL,IPPROC(IVISLS(ISCAL))) designe VISLS (IEL ,ISCAL)
72
58
 
73
59
!      PROPFA(IFAC,IPPROF(IFLUMA(IVAR ))) designe FLUMAS(IFAC,IVAR)
74
60
 
75
 
!      PROPFB(IFAC,IPPROB(IROM  (IPHAS))) designe ROMB  (IFAC,IPHAS)
 
61
!      PROPFB(IFAC,IPPROB(IROM  )) designe ROMB  (IFAC)
76
62
!      PROPFB(IFAC,IPPROB(IFLUMA(IVAR ))) designe FLUMAB(IFAC,IVAR)
77
63
 
78
64
! LA MODIFICATION DES PROPRIETES PHYSIQUES (ROM, VISCL, VISCLS, CP)
83
69
!__________________.____._____.________________________________________________.
84
70
! name             !type!mode ! role                                           !
85
71
!__________________!____!_____!________________________________________________!
86
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
87
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
88
 
! ndim             ! i  ! <-- ! spatial dimension                              !
89
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
90
 
! ncel             ! i  ! <-- ! number of cells                                !
91
 
! nfac             ! i  ! <-- ! number of interior faces                       !
92
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
93
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
94
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
95
 
! nnod             ! i  ! <-- ! number of vertices                             !
96
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
97
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
98
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
99
72
! nvar             ! i  ! <-- ! total number of variables                      !
100
73
! nscal            ! i  ! <-- ! total number of scalars                        !
101
 
! nphas            ! i  ! <-- ! number of phases                               !
102
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
103
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
104
 
! ifacel(2, nfac)  ! ia ! <-- ! interior faces -> cells connectivity           !
105
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
106
 
! ifmfbr(nfabor)   ! ia ! <-- ! boundary face family numbers                   !
107
 
! ifmcel(ncelet)   ! ia ! <-- ! cell family numbers                            !
108
 
! iprfml           ! ia ! <-- ! property numbers per family                    !
109
 
!  (nfml, nprfml)  !    !     !                                                !
110
 
! maxelt           ! i  ! <-- ! max number of cells and faces (int/boundary)   !
111
 
! lstelt(maxelt)   ! ia ! --- ! work array                                     !
112
 
! ipnfac(nfac+1)   ! ia ! <-- ! interior faces -> vertices index (optional)    !
113
 
! nodfac(lndfac)   ! ia ! <-- ! interior faces -> vertices list (optional)     !
114
 
! ipnfbr(nfabor+1) ! ia ! <-- ! boundary faces -> vertices index (optional)    !
115
 
! nodfbr(lndfbr)   ! ia ! <-- ! boundary faces -> vertices list (optional)     !
116
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
117
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
118
 
! ia(*)            ! ia ! --- ! main integer work array                        !
119
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
120
 
!  (ndim, ncelet)  !    !     !                                                !
121
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
122
 
!  (ndim, nfac)    !    !     !                                                !
123
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
124
 
!  (ndim, nfabor)  !    !     !                                                !
125
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
126
 
!  (ndim, nfac)    !    !     !                                                !
127
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
128
 
!  (ndim, nfabor)  !    !     !                                                !
129
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !
130
 
!  (ndim, nnod)    !    !     !                                                !
131
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !
132
74
! dt(ncelet)       ! tr ! <-- ! valeur du pas de temps                         !
133
75
! rtp              ! tr ! <-- ! variables de calcul au centre des              !
134
76
! (ncelet,*)       !    !     !    cellules                                    !
137
79
! propfb(nfabor, *)! ra ! <-- ! physical properties at boundary face centers   !
138
80
! coefa coefb      ! tr ! <-- ! conditions aux limites aux                     !
139
81
!  (nfabor,*)      !    !     !    faces de bord                               !
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
82
!__________________!____!_____!________________________________________________!
144
83
 
145
84
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
148
87
!            --- tableau de travail
149
88
!===============================================================================
150
89
 
 
90
!===============================================================================
 
91
! Module files
 
92
!===============================================================================
 
93
 
 
94
use paramx
 
95
use numvar
 
96
use optcal
 
97
use cstphy
 
98
use cstnum
 
99
use entsor
 
100
use parall
 
101
use ppppar
 
102
use ppthch
 
103
use coincl
 
104
use cpincl
 
105
use ppincl
 
106
use mesh
 
107
 
 
108
!===============================================================================
 
109
 
151
110
implicit none
152
111
 
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 "parall.h"
164
 
include "ppppar.h"
165
 
include "ppthch.h"
166
 
include "coincl.h"
167
 
include "cpincl.h"
168
 
include "ppincl.h"
169
 
 
170
 
!===============================================================================
171
 
 
172
 
integer          idbia0 , idbra0
173
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
174
 
integer          nfml   , nprfml
175
 
integer          nnod   , lndfac , lndfbr , ncelbr
176
 
integer          nvar   , nscal  , nphas
177
 
integer          nideve , nrdeve , nituse , nrtuse
178
 
 
179
 
integer          ifacel(2,nfac) , ifabor(nfabor)
180
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
181
 
integer          iprfml(nfml,nprfml), maxelt, lstelt(maxelt)
182
 
integer          ipnfac(nfac+1), nodfac(lndfac)
183
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr)
184
 
integer          idevel(nideve), ituser(nituse), ia(*)
185
 
 
186
 
double precision xyzcen(ndim,ncelet)
187
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
188
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
189
 
double precision xyznod(ndim,nnod), volume(ncelet)
 
112
integer          nvar   , nscal
 
113
 
 
114
 
190
115
double precision dt(ncelet), rtp(ncelet,*), propce(ncelet,*)
191
116
double precision propfa(nfac,*), propfb(nfabor,*)
192
117
double precision coefa(nfabor,*), coefb(nfabor,*)
193
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
194
118
 
195
119
! Local variables
196
120
 
197
 
integer          idebia, idebra
198
121
 
199
122
 
200
123
!===============================================================================
203
126
! 1.  INITIALISATION VARIABLES LOCALES
204
127
!===============================================================================
205
128
 
206
 
idebia = idbia0
207
 
idebra = idbra0
208
129
 
209
130
!===============================================================================
210
131
! 2. AIGUILLAGE VERS LE MODELE ADEQUAT
217
138
 if ( ippmod(icod3p).ge.0 ) then
218
139
  call d3pini                                                     &
219
140
  !==========
220
 
 ( idebia , idebra ,                                              &
221
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
222
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
223
 
   nvar   , nscal  , nphas  ,                                     &
224
 
   nideve , nrdeve , nituse , nrtuse ,                            &
225
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml , maxelt , lstelt , &
226
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
227
 
   idevel , ituser , ia     ,                                     &
228
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
229
 
   dt     , rtp    , propce , propfa , propfb , coefa  , coefb  , &
230
 
   rdevel , rtuser , ra     )
 
141
 ( nvar   , nscal  ,                                              &
 
142
   dt     , rtp    , propce , propfa , propfb , coefa  , coefb  )
231
143
  endif
232
144
 
233
145
! ---> Combustion gaz
236
148
 if ( ippmod(icoebu).ge.0 ) then
237
149
  call ebuini                                                     &
238
150
  !==========
239
 
 ( idebia , idebra ,                                              &
240
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
241
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
242
 
   nvar   , nscal  , nphas  ,                                     &
243
 
   nideve , nrdeve , nituse , nrtuse ,                            &
244
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml , maxelt , lstelt , &
245
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
246
 
   idevel , ituser , ia     ,                                     &
247
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
248
 
   dt     , rtp    , propce , propfa , propfb , coefa  , coefb  , &
249
 
   rdevel , rtuser , ra     )
 
151
 ( nvar   , nscal  ,                                              &
 
152
   dt     , rtp    , propce , propfa , propfb , coefa  , coefb  )
250
153
endif
251
154
 
252
155
! ---> Combustion gaz
255
158
 if ( ippmod(icolwc).ge.0 ) then
256
159
  call lwcini                                                     &
257
160
  !==========
258
 
 ( idebia , idebra ,                                              &
259
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
260
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
261
 
   nvar   , nscal  , nphas  ,                                     &
262
 
   nideve , nrdeve , nituse , nrtuse ,                            &
263
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml , maxelt , lstelt , &
264
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
265
 
   idevel , ituser , ia     ,                                     &
266
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
267
 
   dt     , rtp    , propce , propfa , propfb , coefa  , coefb  , &
268
 
   rdevel , rtuser , ra     )
 
161
 ( nvar   , nscal  ,                                              &
 
162
   dt     , rtp    , propce , propfa , propfb , coefa  , coefb  )
269
163
endif
270
164
 
271
165