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

« back to all changes in this revision

Viewing changes to users/elec/usetcl.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:
2
2
 
3
3
!VERS
4
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
 
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 usetcl &
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 ,                            &
 
28
 ( nvar   , nscal  ,                                              &
41
29
   icodcl , itrifb , itypfb , izfppp ,                            &
42
 
   idevel , ituser , ia     ,                                     &
43
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
44
30
   dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
45
 
   coefa  , coefb  , rcodcl ,                                     &
46
 
   w1     , w2     , w3     , w4     , w5     , w6     , coefu  , &
47
 
   rdevel , rtuser , ra     )
 
31
   coefa  , coefb  , rcodcl )
48
32
 
49
33
!===============================================================================
50
34
! Purpose  :
83
67
!__________________.____._____.________________________________________________.
84
68
! name             !type!mode ! role                                           !
85
69
!__________________!____!_____!________________________________________________!
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
70
! nvar             ! i  ! <-- ! total number of variables                      !
100
71
! 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           !  e ! <-- ! 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
 
! nodfac(lndfbr)   ! ia ! <-- ! boundary faces -> vertices list (optional)     !
116
72
! icodcl           ! ia ! --> ! boundary condition code                        !
117
73
!  (nfabor, nvar)  !    !     ! = 1  -> Dirichlet                              !
118
74
!                  !    !     ! = 2  -> flux density                           !
122
78
!                  !    !     ! = 9  -> free inlet/outlet (velocity)           !
123
79
!                  !    !     !         inflowing possibly blocked             !
124
80
! itrifb(nfabor    ! ia ! <-- ! indirection for boundary faces ordering)       !
125
 
!  (nfabor, nphas) !    !     !                                                !
126
81
! itypfb           ! ia ! --> ! boundary face types                            !
127
 
!  (nfabor, nphas) !    !     !                                                !
128
 
! idevel(nideve)   ! ia ! <-- ! integer work array for temporary developpement !
129
 
! ituser(nituse    ! ia ! <-- ! user-reserved integer work array               !
130
 
! ia(*)            ! ia ! --- ! main integer work array                        !
131
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
132
 
!  (ndim, ncelet)  !    !     !                                                !
133
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
134
 
!  (ndim, nfac)    !    !     !                                                !
135
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
136
 
!  (ndim, nfavor)  !    !     !                                                !
137
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
138
 
!  (ndim, nfac)    !    !     !                                                !
139
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
140
 
!  (ndim, nfabor)  !    !     !                                                !
141
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !
142
 
!  (ndim, nnod)    !    !     !                                                !
143
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !
144
82
! dt(ncelet)       ! ra ! <-- ! time step (per cell)                           !
145
83
! rtp, rtpa        ! ra ! <-- ! calculated variables at cell centers           !
146
84
!  (ncelet, *)     !    !     !  (at current and preceding time steps)         !
159
97
!                  !    !     ! for velocities           ( vistl+visct)*gradu  !
160
98
!                  !    !     ! for pressure                         dt*gradp  !
161
99
!                  !    !     ! for scalars    cp*(viscls+visct/sigmas)*gradt  !
162
 
! w1,2,3,4,5,6     ! ra ! --- ! work arrays                                    !
163
 
!  (ncelet)        !    !     !  (computation of pressure gradient)            !
164
 
! coefu            ! ra ! --- ! tab de trav                                    !
165
 
!  (nfabor, 3)     !    !     !  (computation of pressure gradient)            !
166
 
! rdevel(nrdeve)   ! ra ! <-> ! tab reel complementaire developemt             !
167
 
! rdevel(nideve)   ! ra ! <-- ! real work array for temporary developpement    !
168
 
! rtuser(nituse    ! ra ! <-- ! user-reserved real work array                  !
169
 
! ra(*)            ! ra ! --- ! main real work array                           !
170
100
!__________________!____!_____!________________________________________________!
171
101
 
172
102
!     Type: i (integer), r (real), s (string), a (array), l (logical),
174
104
!     mode: <-- input, --> output, <-> modifies data, --- work array
175
105
!===============================================================================
176
106
 
 
107
!===============================================================================
 
108
! Module files
 
109
!===============================================================================
 
110
 
 
111
use paramx
 
112
use numvar
 
113
use optcal
 
114
use cstphy
 
115
use cstnum
 
116
use entsor
 
117
use ppppar
 
118
use ppthch
 
119
use ppincl
 
120
use elincl
 
121
use mesh
 
122
 
 
123
!===============================================================================
 
124
 
177
125
implicit none
178
126
 
179
 
!===============================================================================
180
 
!     Common blocks
181
 
!===============================================================================
182
 
 
183
 
include "paramx.h"
184
 
include "numvar.h"
185
 
include "optcal.h"
186
 
include "cstphy.h"
187
 
include "cstnum.h"
188
 
include "entsor.h"
189
 
include "ppppar.h"
190
 
include "ppthch.h"
191
 
include "ppincl.h"
192
 
include "elincl.h"
193
 
 
194
 
!===============================================================================
195
 
 
196
127
! Arguments
197
128
 
198
 
integer          idbia0 , idbra0
199
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
200
 
integer          nfml   , nprfml
201
 
integer          nnod   , lndfac , lndfbr , ncelbr
202
 
integer          nvar   , nscal  , nphas
203
 
integer          nideve , nrdeve , nituse , nrtuse
 
129
integer          nvar   , nscal
204
130
 
205
 
integer          ifacel(2,nfac) , ifabor(nfabor)
206
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
207
 
integer          iprfml(nfml,nprfml)
208
 
integer          maxelt, lstelt(maxelt)
209
 
integer          ipnfac(nfac+1), nodfac(lndfac)
210
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr)
211
131
integer          icodcl(nfabor,nvar)
212
 
integer          itrifb(nfabor,nphas), itypfb(nfabor,nphas)
 
132
integer          itrifb(nfabor), itypfb(nfabor)
213
133
integer          izfppp(nfabor)
214
 
integer          idevel(nideve), ituser(nituse), ia(*)
215
134
 
216
 
double precision xyzcen(ndim,ncelet)
217
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
218
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
219
 
double precision xyznod(ndim,nnod), volume(ncelet)
220
135
double precision dt(ncelet), rtp(ncelet,*), rtpa(ncelet,*)
221
136
double precision propce(ncelet,*)
222
137
double precision propfa(nfac,*), propfb(nfabor,*)
223
138
double precision coefa(nfabor,*), coefb(nfabor,*)
224
139
double precision rcodcl(nfabor,nvar,3)
225
 
double precision w1(ncelet),w2(ncelet),w3(ncelet)
226
 
double precision w4(ncelet),w5(ncelet),w6(ncelet)
227
 
double precision coefu(nfabor,ndim)
228
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
229
140
 
230
141
! Local variables
231
142
 
232
 
integer          idebia, idebra
233
 
integer          ifac  , ii     , iphas , iel
 
143
integer          ifac  , ii     , iel
234
144
integer          i     , ntf    , nb    , id , itrouv
235
145
integer          izone
236
146
integer          nborne(nbtrmx)
243
153
double precision sirt(nbtrmx)  ,siit(nbtrmx)
244
154
character*200    chain
245
155
 
 
156
integer, allocatable, dimension(:) :: lstelt
 
157
 
246
158
!===============================================================================
247
159
!===============================================================================
248
160
! 1.  INITIALISATIONS
249
 
 
250
161
!===============================================================================
251
162
 
252
 
idebia = idbia0
253
 
idebra = idbra0
 
163
! Allocate a temporary array for boundary faces selection
 
164
allocate(lstelt(nfabor))
 
165
 
254
166
 
255
167
!===============================================================================
256
168
! 2.  Allocation of Boundary Conditions
283
195
 
284
196
!     Loop on selected boundary faces
285
197
 
286
 
iphas = 1
287
 
 
288
198
do i=1,nbelec
289
199
 
290
200
  CHAIN = ' '
435
345
 
436
346
!     Loop on selected Boundary Faces
437
347
 
438
 
iphas = 1
439
 
 
440
348
do i=1,nbelec
441
349
 
442
350
  CHAIN = ' '
451
359
 
452
360
    iel = ifabor(ifac)
453
361
 
454
 
    itypfb(ifac,iphas) = iparoi
 
362
    itypfb(ifac) = iparoi
455
363
 
456
364
!     - Zone number
457
365
    izone = i
493
401
  itrouv = 0
494
402
  do ifac = 1, nfabor
495
403
 
496
 
    iphas = 1
497
 
 
498
 
    if ( itypfb(ifac,iphas) .eq. iparoi ) then
 
404
    if ( itypfb(ifac) .eq. iparoi ) then
499
405
 
500
406
      if (icodcl(ifac,isca(ipotr)) .eq. 1 ) then
501
407
 
548
454
! END
549
455
!----
550
456
 
 
457
! Deallocate the temporary array
 
458
deallocate(lstelt)
 
459
 
 
460
return
551
461
end subroutine