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

« back to all changes in this revision

Viewing changes to src/cplv/cplini.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 cplini &
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 :
74
60
!     PROPCE (prop au centre), PROPFA (aux faces internes),
75
61
!     PROPFB (prop aux faces de bord)
76
62
!     Ainsi,
77
 
!      PROPCE(IEL,IPPROC(IROM  (IPHAS))) designe ROM   (IEL ,IPHAS)
78
 
!      PROPCE(IEL,IPPROC(IVISCL(IPHAS))) designe VISCL (IEL ,IPHAS)
79
 
!      PROPCE(IEL,IPPROC(ICP   (IPHAS))) designe CP    (IEL ,IPHAS)
 
63
!      PROPCE(IEL,IPPROC(IROM  )) designe ROM   (IEL)
 
64
!      PROPCE(IEL,IPPROC(IVISCL)) designe VISCL (IEL)
 
65
!      PROPCE(IEL,IPPROC(ICP   )) designe CP    (IEL)
80
66
!      PROPCE(IEL,IPPROC(IVISLS(ISCAL))) designe VISLS (IEL ,ISCAL)
81
67
 
82
68
!      PROPFA(IFAC,IPPROF(IFLUMA(IVAR ))) designe FLUMAS(IFAC,IVAR)
83
69
 
84
 
!      PROPFB(IFAC,IPPROB(IROM  (IPHAS))) designe ROMB  (IFAC,IPHAS)
 
70
!      PROPFB(IFAC,IPPROB(IROM  )) designe ROMB  (IFAC)
85
71
!      PROPFB(IFAC,IPPROB(IFLUMA(IVAR ))) designe FLUMAB(IFAC,IVAR)
86
72
 
87
73
! LA MODIFICATION DES PROPRIETES PHYSIQUES (ROM, VISCL, VISCLS, CP)
92
78
!__________________.____._____.________________________________________________.
93
79
! name             !type!mode ! role                                           !
94
80
!__________________!____!_____!________________________________________________!
95
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
96
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
97
 
! ndim             ! i  ! <-- ! spatial dimension                              !
98
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
99
 
! ncel             ! i  ! <-- ! number of cells                                !
100
 
! nfac             ! i  ! <-- ! number of interior faces                       !
101
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
102
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
103
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
104
 
! nnod             ! i  ! <-- ! number of vertices                             !
105
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
106
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
107
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
108
81
! nvar             ! i  ! <-- ! total number of variables                      !
109
82
! nscal            ! i  ! <-- ! total number of scalars                        !
110
 
! nphas            ! i  ! <-- ! number of phases                               !
111
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
112
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
113
 
! ifacel(2, nfac)  ! ia ! <-- ! interior faces -> cells connectivity           !
114
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
115
 
! ifmfbr(nfabor)   ! ia ! <-- ! boundary face family numbers                   !
116
 
! ifmcel(ncelet)   ! ia ! <-- ! cell family numbers                            !
117
 
! iprfml           ! ia ! <-- ! property numbers per family                    !
118
 
!  (nfml, nprfml)  !    !     !                                                !
119
 
! maxelt           ! i  ! <-- ! max number of cells and faces (int/boundary)   !
120
 
! lstelt(maxelt)   ! ia ! --- ! work array                                     !
121
 
! ipnfac           ! te ! <-- ! position du premier noeud de chaque            !
122
 
!   (lndfac)       !    !     !  face interne dans nodfac                      !
123
 
! nodfac           ! te ! <-- ! connectivite faces internes/noeuds             !
124
 
!   (nfac+1)       !    !     !                                                !
125
 
! ipnfbr           ! te ! <-- ! position du premier noeud de chaque            !
126
 
!   (lndfbr)       !    !     !  face de bord dans nodfbr                      !
127
 
! nodfbr           ! te ! <-- ! connectivite faces de bord/noeuds              !
128
 
!   (nfabor+1)     !    !     !                                                !
129
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
130
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
131
 
! ia(*)            ! ia ! --- ! main integer work array                        !
132
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
133
 
!  (ndim, ncelet)  !    !     !                                                !
134
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
135
 
!  (ndim, nfac)    !    !     !                                                !
136
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
137
 
!  (ndim, nfabor)  !    !     !                                                !
138
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
139
 
!  (ndim, nfac)    !    !     !                                                !
140
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
141
 
!  (ndim, nfabor)  !    !     !                                                !
142
 
! xyznod           ! tr ! <-- ! coordonnes des noeuds                          !
143
 
! (ndim,nnod)      !    !     !                                                !
144
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !
145
83
! dt(ncelet)       ! tr ! <-- ! valeur du pas de temps                         !
146
84
! rtp              ! tr ! <-- ! variables de calcul au centre des              !
147
85
! (ncelet,*)       !    !     !    cellules                                    !
150
88
! propfb(nfabor, *)! ra ! <-- ! physical properties at boundary face centers   !
151
89
! coefa coefb      ! tr ! <-- ! conditions aux limites aux                     !
152
90
!  (nfabor,*)      !    !     !    faces de bord                               !
153
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
154
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
155
 
! ra(*)            ! ra ! --- ! main real work array                           !
156
91
!__________________!____!_____!________________________________________________!
157
92
 
158
93
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
161
96
!            --- tableau de travail
162
97
!===============================================================================
163
98
 
 
99
!===============================================================================
 
100
! Module files
 
101
!===============================================================================
 
102
 
 
103
use paramx
 
104
use numvar
 
105
use optcal
 
106
use cstphy
 
107
use cstnum
 
108
use entsor
 
109
use ppppar
 
110
use ppthch
 
111
use coincl
 
112
use cpincl
 
113
use ppincl
 
114
use ppcpfu
 
115
use mesh
 
116
 
 
117
!===============================================================================
 
118
 
164
119
implicit none
165
120
 
166
 
!===============================================================================
167
 
! Common blocks
168
 
!===============================================================================
169
 
 
170
 
include "paramx.h"
171
 
include "numvar.h"
172
 
include "optcal.h"
173
 
include "cstphy.h"
174
 
include "cstnum.h"
175
 
include "entsor.h"
176
 
include "ppppar.h"
177
 
include "ppthch.h"
178
 
include "coincl.h"
179
 
include "cpincl.h"
180
 
include "ppincl.h"
181
 
include "ppcpfu.h"
182
 
 
183
 
!===============================================================================
184
 
 
185
 
integer          idbia0 , idbra0
186
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
187
 
integer          nfml   , nprfml
188
 
integer          nnod   , lndfac , lndfbr , ncelbr
189
 
integer          nvar   , nscal  , nphas
190
 
integer          nideve , nrdeve , nituse , nrtuse
191
 
 
192
 
integer          ifacel(2,nfac) , ifabor(nfabor)
193
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
194
 
integer          iprfml(nfml,nprfml), maxelt, lstelt(maxelt)
195
 
integer          ipnfac(nfac+1), nodfac(lndfac)
196
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr)
197
 
integer          idevel(nideve), ituser(nituse), ia(*)
198
 
 
199
 
double precision xyzcen(ndim,ncelet)
200
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
201
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
202
 
double precision xyznod(ndim,nnod), volume(ncelet)
 
121
integer          nvar   , nscal
 
122
 
 
123
 
203
124
double precision dt(ncelet), rtp(ncelet,*), propce(ncelet,*)
204
125
double precision propfa(nfac,*), propfb(nfabor,*)
205
126
double precision coefa(nfabor,*), coefb(nfabor,*)
206
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
207
127
 
208
128
! Local variables
209
129
 
210
 
integer          idebia, idebra
211
 
integer          iel, ige, mode, icha, iphas
 
130
integer          iel, ige, mode, icha
212
131
 
213
132
double precision t1init, h1init, coefe(ngazem)
214
133
double precision f1mc(ncharm), f2mc(ncharm)
228
147
 
229
148
ipass = ipass + 1
230
149
 
231
 
idebia = idbia0
232
 
idebra = idbra0
233
150
 
234
151
d2s3 = 2.d0/3.d0
235
152
 
242
159
 
243
160
if ( isuite.eq.0 .and. ipass.eq.1 ) then
244
161
 
245
 
  iphas = 1
246
 
 
247
162
! --> Initialisation de k et epsilon
248
163
 
249
164
  xkent = 1.d-10
250
165
  xeent = 1.d-10
251
166
 
252
 
  if (itytur(iphas).eq.2) then
253
 
 
254
 
    do iel = 1, ncel
255
 
      rtp(iel,ik(iphas))  = xkent
256
 
      rtp(iel,iep(iphas)) = xeent
257
 
    enddo
258
 
 
259
 
  elseif (itytur(iphas).eq.3) then
260
 
 
261
 
    do iel = 1, ncel
262
 
      rtp(iel,ir11(iphas)) = d2s3*xkent
263
 
      rtp(iel,ir22(iphas)) = d2s3*xkent
264
 
      rtp(iel,ir33(iphas)) = d2s3*xkent
265
 
      rtp(iel,ir12(iphas)) = 0.d0
266
 
      rtp(iel,ir13(iphas)) = 0.d0
267
 
      rtp(iel,ir23(iphas)) = 0.d0
268
 
      rtp(iel,iep(iphas))  = xeent
269
 
    enddo
270
 
 
271
 
  elseif (iturb(iphas).eq.50) then
272
 
 
273
 
    do iel = 1, ncel
274
 
      rtp(iel,ik(iphas))   = xkent
275
 
      rtp(iel,iep(iphas))  = xeent
276
 
      rtp(iel,iphi(iphas)) = d2s3
277
 
      rtp(iel,ifb(iphas))  = 0.d0
278
 
    enddo
279
 
 
280
 
  elseif (iturb(iphas).eq.60) then
281
 
 
282
 
    do iel = 1, ncel
283
 
      rtp(iel,ik(iphas))   = xkent
284
 
      rtp(iel,iomg(iphas)) = xeent/cmu/xkent
 
167
  if (itytur.eq.2) then
 
168
 
 
169
    do iel = 1, ncel
 
170
      rtp(iel,ik)  = xkent
 
171
      rtp(iel,iep) = xeent
 
172
    enddo
 
173
 
 
174
  elseif (itytur.eq.3) then
 
175
 
 
176
    do iel = 1, ncel
 
177
      rtp(iel,ir11) = d2s3*xkent
 
178
      rtp(iel,ir22) = d2s3*xkent
 
179
      rtp(iel,ir33) = d2s3*xkent
 
180
      rtp(iel,ir12) = 0.d0
 
181
      rtp(iel,ir13) = 0.d0
 
182
      rtp(iel,ir23) = 0.d0
 
183
      rtp(iel,iep)  = xeent
 
184
    enddo
 
185
 
 
186
  elseif (iturb.eq.50) then
 
187
 
 
188
    do iel = 1, ncel
 
189
      rtp(iel,ik)   = xkent
 
190
      rtp(iel,iep)  = xeent
 
191
      rtp(iel,iphi) = d2s3
 
192
      rtp(iel,ifb)  = 0.d0
 
193
    enddo
 
194
 
 
195
  elseif (iturb.eq.60) then
 
196
 
 
197
    do iel = 1, ncel
 
198
      rtp(iel,ik)   = xkent
 
199
      rtp(iel,iomg) = xeent/cmu/xkent
 
200
    enddo
 
201
 
 
202
  elseif (iturb.eq.70) then
 
203
 
 
204
    do iel = 1, ncel
 
205
      rtp(iel,inusa) = cmu*xkent**2/xeent
285
206
    enddo
286
207
 
287
208
  endif
291
212
 
292
213
!   Enthalpie
293
214
 
294
 
  t1init = t0(iphas)
 
215
  t1init = t0
295
216
 
296
217
! ------ Variables de transport relatives au melange
297
218