← Back to branch summary

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

« back to all changes in this revision

Viewing changes to users/cogz/uslwci.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:
users/cogz/uslwci.f90
1
1
!-------------------------------------------------------------------------------
2
2
 
3
 
!                      Code_Saturne version 2.0.0-beta2
4
 
!                      --------------------------
5
 
 
6
 
!     This file is part of the Code_Saturne Kernel, element of the
7
 
!     Code_Saturne CFD tool.
8
 
 
9
 
!     Copyright (C) 1998-2009 EDF S.A., France
10
 
 
11
 
!     contact: saturne-support@edf.fr
12
 
 
13
 
!     The Code_Saturne Kernel is free software; you can redistribute it
14
 
!     and/or modify it under the terms of the GNU General Public License
15
 
!     as published by the Free Software Foundation; either version 2 of
16
 
!     the License, or (at your option) any later version.
17
 
 
18
 
!     The Code_Saturne Kernel is distributed in the hope that it will be
19
 
!     useful, but WITHOUT ANY WARRANTY; without even the implied warranty
20
 
!     of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
21
 
!     GNU General Public License for more details.
22
 
 
23
 
!     You should have received a copy of the GNU General Public License
24
 
!     along with the Code_Saturne Kernel; if not, write to the
25
 
!     Free Software Foundation, Inc.,
26
 
!     51 Franklin St, Fifth Floor,
27
 
!     Boston, MA  02110-1301  USA
 
3
!VERS
 
4
 
 
5
! This file is part of Code_Saturne, a general-purpose CFD tool.
 
6
!
 
7
! Copyright (C) 1998-2011 EDF S.A.
 
8
!
 
9
! This program is free software; you can redistribute it and/or modify it under
 
10
! the terms of the GNU General Public License as published by the Free Software
 
11
! Foundation; either version 2 of the License, or (at your option) any later
 
12
! version.
 
13
!
 
14
! This program is distributed in the hope that it will be useful, but WITHOUT
 
15
! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
 
16
! FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
 
17
! details.
 
18
!
 
19
! You should have received a copy of the GNU General Public License along with
 
20
! this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
 
21
! Street, Fifth Floor, Boston, MA 02110-1301, USA.
28
22
 
29
23
!-------------------------------------------------------------------------------
30
24
 
31
25
subroutine uslwci &
32
26
!================
33
27
 
34
 
 ( idbia0 , idbra0 ,                                              &
35
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
36
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
37
 
   nvar   , nscal  , nphas  ,                                     &
38
 
   nideve , nrdeve , nituse , nrtuse ,                            &
39
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml , maxelt , lstelt , &
40
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
41
 
   idevel , ituser , ia     ,                                     &
42
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
43
 
   dt     , rtp    , propce , propfa , propfb , coefa  , coefb  , &
44
 
   rdevel , rtuser , ra     )
 
28
 ( nvar   , nscal  ,                                              &
 
29
   dt     , rtp    , propce , propfa , propfb , coefa  , coefb  )
45
30
 
46
31
!===============================================================================
47
32
! PURPOSE :
64
49
!   c) PROPFB (Properties at boundary faces).
65
50
!
66
51
!   Examples:
67
 
!   PROPCE(IEL,IPPROC(IROM  (IPHAS))) =  IROM of cell IEL of phase IPHAS
68
 
!   PROPCE(IEL,IPPROC(ICP   (IPHAS))) =  ICP  of cell IEL of phase IPHAS
 
52
!   PROPCE(IEL,IPPROC(IROM  )) =  IROM of cell IEL
 
53
!   PROPCE(IEL,IPPROC(ICP   )) =  ICP  of cell IEL
69
54
!
70
55
!   PROPFA(IFAC,IPPROF(IFLUMA(IVAR )))=  FLUMAS of IVAR at the internal face IFAC
71
56
!
72
 
!   PROPFB(IFAC,IPPROB(IROM  (IPHAS)))=  ROMB of IPHAS at the boundary face IFAC
 
57
!   PROPFB(IFAC,IPPROB(IROM  ))=  ROMB at the boundary face IFAC
73
58
!   PROPFB(IFAC,IPPROB(IFLUMA(IVAR )))=  FLUMAB of IVAR at the boundary face IFAC
74
59
 
75
60
!   All cells can be identified by using the subroutine 'getcel'.
139
124
!__________________.____._____.________________________________________________.
140
125
! name             !type!mode ! role                                           !
141
126
!__________________!____!_____!________________________________________________!
142
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
143
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
144
 
! ndim             ! i  ! <-- ! spatial dimension                              !
145
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
146
 
! ncel             ! i  ! <-- ! number of cells                                !
147
 
! nfac             ! i  ! <-- ! number of interior faces                       !
148
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
149
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
150
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
151
 
! nnod             ! i  ! <-- ! number of vertices                             !
152
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
153
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
154
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
155
127
! nvar             ! i  ! <-- ! total number of variables                      !
156
128
! nscal            ! i  ! <-- ! total number of scalars                        !
157
 
! nphas            ! i  ! <-- ! number of phases                               !
158
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
159
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
160
 
! ifacel(2, nfac)  ! ia ! <-- ! interior faces -> cells connectivity           !
161
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
162
 
! ifmfbr(nfabor)   ! ia ! <-- ! boundary face family numbers                   !
163
 
! ifmcel(ncelet)   ! ia ! <-- ! cell family numbers                            !
164
 
! iprfml           ! ia ! <-- ! property numbers per family                    !
165
 
!  (nfml, nprfml)  !    !     !                                                !
166
 
! maxelt           !  e ! <-- ! max number of cells and faces (int/boundary)   !
167
 
! lstelt(maxelt)   ! ia ! --- ! work array                                     !
168
 
! ipnfac(nfac+1)   ! ia ! <-- ! interior faces -> vertices index (optional)    !
169
 
! nodfac(lndfac)   ! ia ! <-- ! interior faces -> vertices list (optional)     !
170
 
! ipnfbr(nfabor+1) ! ia ! <-- ! boundary faces -> vertices index (optional)    !
171
 
! nodfac(lndfbr)   ! ia ! <-- ! boundary faces -> vertices list (optional)     !
172
129
! icodcl           ! ia ! --> ! boundary condition code                        !
173
130
!  (nfabor, nvar)  !    !     ! = 1  -> Dirichlet                              !
174
131
!                  !    !     ! = 2  -> flux density                           !
178
135
!                  !    !     ! = 9  -> free inlet/outlet (velocity)           !
179
136
!                  !    !     !         inflowing possibly blocked             !
180
137
! itrifb(nfabor    ! ia ! <-- ! indirection for boundary faces ordering)       !
181
 
!  (nfabor, nphas) !    !     !                                                !
182
138
! itypfb           ! ia ! --> ! boundary face types                            !
183
 
!  (nfabor, nphas) !    !     !                                                !
184
 
! idevel(nideve)   ! ia ! <-- ! integer work array for temporary developpement !
185
 
! ituser(nituse    ! ia ! <-- ! user-reserved integer work array               !
186
 
! ia(*)            ! ia ! --- ! main integer work array                        !
187
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
188
 
!  (ndim, ncelet)  !    !     !                                                !
189
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
190
 
!  (ndim, nfac)    !    !     !                                                !
191
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
192
 
!  (ndim, nfavor)  !    !     !                                                !
193
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
194
 
!  (ndim, nfac)    !    !     !                                                !
195
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
196
 
!  (ndim, nfabor)  !    !     !                                                !
197
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !
198
 
!  (ndim, nnod)    !    !     !                                                !
199
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !
200
139
! dt(ncelet)       ! ra ! <-- ! time step (per cell)                           !
201
140
! rtp, rtpa        ! ra ! <-- ! calculated variables at cell centers           !
202
141
!  (ncelet, *)     !    !     !  (at current and preceding time steps)         !
215
154
!                  !    !     ! for velocities           ( vistl+visct)*gradu  !
216
155
!                  !    !     ! for pressure                         dt*gradp  !
217
156
!                  !    !     ! for scalars    cp*(viscls+visct/sigmas)*gradt  !
218
 
! w1,2,3,4,5,6     ! ra ! --- ! work arrays                                    !
219
 
!  (ncelet)        !    !     !  (computation of pressure gradient)            !
220
 
! coefu            ! ra ! --- ! tab de trav                                    !
221
 
!  (nfabor, 3)     !    !     !  (computation of pressure gradient)            !
222
 
! rdevel(nrdeve)   ! ra ! <-> ! tab reel complementaire developemt             !
223
 
! rdevel(nideve)   ! ra ! <-- ! real work array for temporary developpement    !
224
 
! rtuser(nituse    ! ra ! <-- ! user-reserved real work array                  !
225
 
! ra(*)            ! ra ! --- ! main real work array                           !
226
157
!__________________!____!_____!________________________________________________!
227
158
 
228
159
!     Type: i (integer), r (real), s (string), a (array), l (logical),
230
161
!     mode: <-- input, --> output, <-> modifies data, --- work array
231
162
!===============================================================================
232
163
 
 
164
!===============================================================================
 
165
! Module files
 
166
!===============================================================================
 
167
 
 
168
use paramx
 
169
use pointe
 
170
use numvar
 
171
use optcal
 
172
use cstphy
 
173
use cstnum
 
174
use entsor
 
175
use parall
 
176
use period
 
177
use ppppar
 
178
use ppthch
 
179
use coincl
 
180
use cpincl
 
181
use ppincl
 
182
use mesh
 
183
 
 
184
!===============================================================================
 
185
 
233
186
implicit none
234
187
 
235
 
!===============================================================================
236
 
!     Common Blocks
237
 
!===============================================================================
238
 
 
239
 
include "paramx.h"
240
 
include "pointe.h"
241
 
include "numvar.h"
242
 
include "optcal.h"
243
 
include "cstphy.h"
244
 
include "cstnum.h"
245
 
include "entsor.h"
246
 
include "parall.h"
247
 
include "period.h"
248
 
include "ppppar.h"
249
 
include "ppthch.h"
250
 
include "coincl.h"
251
 
include "cpincl.h"
252
 
include "ppincl.h"
253
 
 
254
 
!===============================================================================
255
188
! Arguments
256
 
integer          idbia0 , idbra0
257
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
258
 
integer          nfml   , nprfml
259
 
integer          nnod   , lndfac , lndfbr , ncelbr
260
 
integer          nvar   , nscal  , nphas
261
 
integer          nideve , nrdeve , nituse , nrtuse
262
 
 
263
 
integer          ifacel(2,nfac) , ifabor(nfabor)
264
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
265
 
integer          iprfml(nfml,nprfml), maxelt, lstelt(maxelt)
266
 
integer          ipnfac(nfac+1), nodfac(lndfac)
267
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr)
268
 
integer          idevel(nideve), ituser(nituse), ia(*)
269
 
 
270
 
double precision xyzcen(ndim,ncelet)
271
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
272
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
273
 
double precision xyznod(ndim,nnod), volume(ncelet)
 
189
 
 
190
integer          nvar   , nscal
 
191
 
274
192
double precision dt(ncelet), rtp(ncelet,*), propce(ncelet,*)
275
193
double precision propfa(nfac,*), propfb(nfabor,*)
276
194
double precision coefa(nfabor,*), coefb(nfabor,*)
277
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
278
195
 
279
196
! Local Variables
280
197
 
281
 
integer          idebia, idebra
282
 
integer          iel, mode, igg, iphas, izone
 
198
integer          iel, mode, igg, izone
283
199
double precision hinit, coefg(ngazgm)
284
200
double precision sommqf, sommqt, sommq, tentm, fmelm
285
201
 
288
204
integer          iscal, ivar, ii
289
205
double precision valmax, valmin
290
206
 
 
207
integer, allocatable, dimension(:) :: lstelt
 
208
 
291
209
!===============================================================================
292
210
 
293
211
 
302
220
! 1.  INITIALISATION OF LOCAL VARIABLES
303
221
!===============================================================================
304
222
 
305
 
idebia = idbia0
306
 
idebra = idbra0
 
223
! Allocate a temporary array for cells selection
 
224
allocate(lstelt(ncel))
 
225
 
307
226
 
308
227
do igg = 1, ngazgm
309
228
  coefg(igg) = zero
310
229
enddo
311
230
 
312
 
iphas  = 1
313
 
 
314
231
!===============================================================================
315
232
! 2. INITIALISATION OF TRANSPORTED VARIABLES
316
233
!===============================================================================
335
252
    tentm = sommqt / sommq
336
253
  else
337
254
    fmelm = zero
338
 
    tentm = t0(iphas)
 
255
    tentm = t0
339
256
  endif
340
257
 
341
258
! ----- Calculation of the Enthalpy of the gas mixture
443
360
! END
444
361
!----
445
362
 
 
363
! Deallocate the temporary array
 
364
deallocate(lstelt)
 
365
 
446
366
return
447
367
end subroutine