← Back to branch summary

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

« back to all changes in this revision

Viewing changes to users/elec/uselph.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/elec/uselph.f90
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 uselph &
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 , nphmx  ,                   &
39
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml , maxelt , lstelt , &
40
 
   ipnfac , nodfac , ipnfbr , nodfbr , ibrom  , izfppp ,          &
41
 
   idevel , ituser , ia     ,                                     &
42
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
28
 ( nvar   , nscal  ,                                              &
 
29
   ibrom  , izfppp ,                                              &
43
30
   dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
44
 
   coefa  , coefb  ,                                              &
45
 
   w1     , w2     , w3     , w4     ,                            &
46
 
   w5     , w6     , w7     , w8     ,                            &
47
 
   rdevel , rtuser , ra     )
 
31
   coefa  , coefb  )
48
32
 
49
33
!===============================================================================
50
34
! FONCTION :
85
69
!    Ainsi, AU PREMIER PAS DE TEMPS (calcul non suite), les seules
86
70
!    grandeurs initialisees avant appel sont celles donnees
87
71
!      - dans usini1 :
88
 
!             . la masse volumique (initialisee a RO0(IPHAS))
89
 
!             . la viscosite       (initialisee a VISCL0(IPHAS))
 
72
!             . la masse volumique (initialisee a RO0)
 
73
!             . la viscosite       (initialisee a VISCL0)
90
74
!      - dans usiniv/useliv :
91
75
!             . les variables de calcul  (initialisees a 0 par defaut
92
76
!             ou a l
122
106
!__________________.____._____.________________________________________________.
123
107
! name             !type!mode ! role                                           !
124
108
!__________________!____!_____!________________________________________________!
125
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
126
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
127
 
! ndim             ! i  ! <-- ! spatial dimension                              !
128
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
129
 
! ncel             ! i  ! <-- ! number of cells                                !
130
 
! nfac             ! i  ! <-- ! number of interior faces                       !
131
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
132
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
133
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
134
 
! nnod             ! i  ! <-- ! number of vertices                             !
135
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
136
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
137
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
138
109
! nvar             ! i  ! <-- ! total number of variables                      !
139
110
! nscal            ! i  ! <-- ! total number of scalars                        !
140
 
! nphas            ! i  ! <-- ! number of phases                               !
141
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
142
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
143
 
! nphmx            ! e  ! <-- ! nphsmx                                         !
144
 
! ifacel(2, nfac)  ! ia ! <-- ! interior faces -> cells connectivity           !
145
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
146
 
! ifmfbr(nfabor)   ! ia ! <-- ! boundary face family numbers                   !
147
 
! ifmcel(ncelet)   ! ia ! <-- ! cell family numbers                            !
148
 
! iprfml           ! ia ! <-- ! property numbers per family                    !
149
 
!  (nfml, nprfml)  !    !     !                                                !
150
 
! maxelt           ! i  ! <-- ! max number of cells and faces (int/boundary)   !
151
 
! lstelt(maxelt)   ! ia ! --- ! work array                                     !
152
 
! ipnfac(nfac+1)   ! ia ! <-- ! interior faces -> vertices index (optional)    !
153
 
! nodfac(lndfac)   ! ia ! <-- ! interior faces -> vertices list (optional)     !
154
 
! ipnfbr(nfabor+1) ! ia ! <-- ! boundary faces -> vertices index (optional)    !
155
 
! nodfbr(lndfbr)   ! ia ! <-- ! boundary faces -> vertices list (optional)     !
156
111
! ibrom            ! te ! <-- ! indicateur de remplissage de romb              !
157
 
!   (nphmx   )     !    !     !                                                !
 
112
!        !    !     !                                                !
158
113
! izfppp           ! te ! <-- ! numero de zone de la face de bord              !
159
114
! (nfabor)         !    !     !  pour le module phys. part.                    !
160
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
161
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
162
 
! ia(*)            ! ia ! --- ! main integer work array                        !
163
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
164
 
!  (ndim, ncelet)  !    !     !                                                !
165
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
166
 
!  (ndim, nfac)    !    !     !                                                !
167
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
168
 
!  (ndim, nfabor)  !    !     !                                                !
169
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
170
 
!  (ndim, nfac)    !    !     !                                                !
171
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
172
 
!  (ndim, nfabor)  !    !     !                                                !
173
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !
174
 
!  (ndim, nnod)    !    !     !                                                !
175
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !
176
115
! dt(ncelet)       ! ra ! <-- ! time step (per cell)                           !
177
116
! rtp, rtpa        ! ra ! <-- ! calculated variables at cell centers           !
178
117
!  (ncelet, *)     !    !     !  (at current and previous time steps)          !
181
120
! propfb(nfabor, *)! ra ! <-- ! physical properties at boundary face centers   !
182
121
! coefa, coefb     ! ra ! <-- ! boundary conditions                            !
183
122
!  (nfabor, *)     !    !     !                                                !
184
 
! w1...8(ncelet    ! tr ! --- ! tableau de travail                             !
185
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
186
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
187
 
! ra(*)            ! ra ! --- ! main real work array                           !
188
123
!__________________!____!_____!________________________________________________!
189
124
 
190
125
!     Type: i (integer), r (real), s (string), a (array), l (logical),
192
127
!     mode: <-- input, --> output, <-> modifies data, --- work array
193
128
!===============================================================================
194
129
 
 
130
!===============================================================================
 
131
! Module files
 
132
!===============================================================================
 
133
 
 
134
use paramx
 
135
use numvar
 
136
use optcal
 
137
use cstphy
 
138
use entsor
 
139
use ppppar
 
140
use ppthch
 
141
use ppincl
 
142
use elincl
 
143
use mesh
 
144
 
 
145
!===============================================================================
 
146
 
195
147
implicit none
196
148
 
197
 
!===============================================================================
198
 
! Common blocks
199
 
!===============================================================================
200
 
 
201
 
include "paramx.h"
202
 
include "numvar.h"
203
 
include "optcal.h"
204
 
include "cstphy.h"
205
 
include "entsor.h"
206
 
include "ppppar.h"
207
 
include "ppthch.h"
208
 
include "ppincl.h"
209
 
include "elincl.h"
210
 
 
211
 
!===============================================================================
212
 
 
213
149
! Arguments
214
150
 
215
 
integer          idbia0 , idbra0
216
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
217
 
integer          nfml   , nprfml
218
 
integer          nnod   , lndfac , lndfbr , ncelbr
219
 
integer          nvar   , nscal  , nphas
220
 
integer          nideve , nrdeve , nituse , nrtuse , nphmx
 
151
integer          nvar   , nscal
221
152
 
222
 
integer          ifacel(2,nfac) , ifabor(nfabor)
223
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
224
 
integer          iprfml(nfml,nprfml), maxelt, lstelt(maxelt)
225
 
integer          ipnfac(nfac+1), nodfac(lndfac)
226
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr), ibrom(nphmx)
 
153
integer          ibrom
227
154
integer          izfppp(nfabor)
228
 
integer          idevel(nideve), ituser(nituse), ia(*)
229
155
 
230
 
double precision xyzcen(ndim,ncelet)
231
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
232
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
233
 
double precision xyznod(ndim,nnod), volume(ncelet)
234
156
double precision dt(ncelet), rtp(ncelet,*), rtpa(ncelet,*)
235
157
double precision propce(ncelet,*)
236
158
double precision propfa(nfac,*), propfb(nfabor,*)
237
159
double precision coefa(nfabor,*), coefb(nfabor,*)
238
 
double precision w1(ncelet),w2(ncelet),w3(ncelet),w4(ncelet)
239
 
double precision w5(ncelet),w6(ncelet),w7(ncelet),w8(ncelet)
240
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
241
160
 
242
161
! Local variables
243
162
 
244
 
integer          idebia, idebra
245
 
integer          iel   , iphas
 
163
integer          iel
246
164
integer          ipcrom, ipcvis, ipccp , ipcvsl, ipcsig
247
165
integer          mode
248
166
 
263
181
 
264
182
! --- Initialisation memoire
265
183
 
266
 
idebia = idbia0
267
 
idebra = idbra0
268
184
 
269
185
ipass = ipass + 1
270
186
 
271
 
iphas = 1
272
 
 
273
187
! TEST_TO_REMOVE_FOR_USE_OF_SUBROUTINE_START
274
188
!===============================================================================
275
189
! 0.  CE TEST PERMET A L'UTILISATEUR D'ETRE CERTAIN QUE C'EST
340
254
 
341
255
!       On n'utilisera donc PAS les variables
342
256
!          =====================
343
 
!                                CP0(IPHAS), VISLS0(ISCALT(IPHAS))
 
257
!                                CP0, VISLS0(ISCALT)
344
258
!                                VISLS0(IPOTR) et VISLS0(IPOTI)
345
259
 
346
260
!       Informatiquement, ceci se traduit par le fait que
347
 
!                                ICP(IPHAS)>0, IVISLS(ISCALT(IPHAS))>0,
 
261
!                                ICP>0, IVISLS(ISCALT)>0,
348
262
!                                IVISLS(IPOTR)>0 et IVISLS(IPOTI)>0
349
263
 
350
264
 
398
312
    srrom1 = 0.d0
399
313
  endif
400
314
 
401
 
  ipcrom = ipproc(irom(iphas))
 
315
  ipcrom = ipproc(irom)
402
316
  do iel = 1, ncel
403
317
    rhonp1 = rom0 /                                               &
404
318
            (1.d0+ dilar * (propce(iel,ipproc(itemp))-temp0) )
422
336
!          (Choudhary)
423
337
!      Plard (HE-25/94/017) ; limite a 1173K par C Delalondre
424
338
 
425
 
  ipcvis = ipproc(iviscl(iphas))
 
339
  ipcvis = ipproc(iviscl)
426
340
  aa     = 10425.d0
427
341
  bb     =   500.d0
428
342
  cc     =-6.0917d0
451
365
!        CP = 1381 (Choudhary)
452
366
!          coherent avec Plard (HE-25/94/017)
453
367
 
454
 
  ipccp  = ipproc(icp(iphas))
 
368
  ipccp  = ipproc(icp)
455
369
  do iel = 1, ncel
456
370
    propce(iel,ipccp) = 1381.d0
457
371
  enddo
473
387
 
474
388
!          Plard (HE-25/94/017)
475
389
 
476
 
  ipcvsl = ipproc(ivisls(iscalt(iphas)))
 
390
  ipcvsl = ipproc(ivisls(iscalt))
477
391
 
478
392
  do iel = 1, ncel
479
393
    xbr = 85.25d0                                                 &