← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/cplv/cpphyv.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:
src/cplv/cpphyv.f90
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 cpphyv &
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 , nphmx  ,                   &
36
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
37
 
   ipnfac , nodfac , ipnfbr , nodfbr , ibrom  , izfppp ,          &
38
 
   idevel , ituser , ia     ,                                     &
39
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
26
 ( nvar   , nscal  ,                                              &
 
27
   ibrom  , izfppp ,                                              &
40
28
   dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
41
 
   coefa  , coefb  ,                                              &
42
 
   f3max  ,                                                       &
43
 
   w1     , w2     , w3     , w4     ,                            &
44
 
   w5     , w6     , w7     , w8     ,                            &
45
 
   w9     , w10    ,                                              &
46
 
   rdevel , rtuser , ra     )
 
29
   coefa  , coefb  )
47
30
 
48
31
!===============================================================================
49
32
! FONCTION :
63
46
!  (une routine specifique est dediee a cela : usvist)
64
47
 
65
48
 
66
 
!  Il FAUT AVOIR PRECISE ICP(IPHAS) = 1
 
49
!  Il FAUT AVOIR PRECISE ICP = 1
67
50
!     ==================
68
51
!    dans usini1 si on souhaite imposer une chaleur specifique
69
 
!    CP variable pour la phase IPHAS (sinon: ecrasement memoire).
 
52
!    CP variable (sinon: ecrasement memoire).
70
53
 
71
54
 
72
55
!  Il FAUT AVOIR PRECISE IVISLS(Numero de scalaire) = 1
85
68
!    Ainsi, AU PREMIER PAS DE TEMPS (calcul non suite), les seules
86
69
!    grandeurs initialisees avant appel sont celles donnees
87
70
!      - dans usini1 :
88
 
!             . la masse volumique (initialisee a RO0(IPHAS))
89
 
!             . la viscosite       (initialisee a VISCL0(IPHAS))
 
71
!             . la masse volumique (initialisee a RO0)
 
72
!             . la viscosite       (initialisee a VISCL0)
90
73
!      - dans usppiv :
91
74
!             . les variables de calcul  (initialisees a 0 par defaut
92
75
!             ou a la valeur donnee dans usiniv)
113
96
!__________________.____._____.________________________________________________.
114
97
! name             !type!mode ! role                                           !
115
98
!__________________!____!_____!________________________________________________!
116
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
117
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
118
 
! ndim             ! i  ! <-- ! spatial dimension                              !
119
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
120
 
! ncel             ! i  ! <-- ! number of cells                                !
121
 
! nfac             ! i  ! <-- ! number of interior faces                       !
122
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
123
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
124
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
125
 
! nnod             ! i  ! <-- ! number of vertices                             !
126
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
127
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
128
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
129
99
! nvar             ! i  ! <-- ! total number of variables                      !
130
100
! nscal            ! i  ! <-- ! total number of scalars                        !
131
 
! nphas            ! i  ! <-- ! number of phases                               !
132
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
133
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
134
 
! nphmx            ! e  ! <-- ! nphsmx                                         !
135
 
! ifacel(2, nfac)  ! ia ! <-- ! interior faces -> cells connectivity           !
136
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
137
 
! ifmfbr(nfabor)   ! ia ! <-- ! boundary face family numbers                   !
138
 
! ifmcel(ncelet)   ! ia ! <-- ! cell family numbers                            !
139
 
! iprfml           ! ia ! <-- ! property numbers per family                    !
140
 
!  (nfml, nprfml)  !    !     !                                                !
141
 
! ipnfac(nfac+1)   ! ia ! <-- ! interior faces -> vertices index (optional)    !
142
 
! nodfac(lndfac)   ! ia ! <-- ! interior faces -> vertices list (optional)     !
143
 
! ipnfbr(nfabor+1) ! ia ! <-- ! boundary faces -> vertices index (optional)    !
144
 
! nodfbr(lndfbr)   ! ia ! <-- ! boundary faces -> vertices list (optional)     !
145
101
! ibrom            ! te ! <-- ! indicateur de remplissage de romb              !
146
 
!   (nphmx   )     !    !     !                                                !
 
102
!        !    !     !                                                !
147
103
! izfppp           ! te ! <-- ! numero de zone de la face de bord              !
148
104
! (nfabor)         !    !     !  pour le module phys. part.                    !
149
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
150
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
151
 
! ia(*)            ! ia ! --- ! main integer work array                        !
152
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
153
 
!  (ndim, ncelet)  !    !     !                                                !
154
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
155
 
!  (ndim, nfac)    !    !     !                                                !
156
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
157
 
!  (ndim, nfabor)  !    !     !                                                !
158
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
159
 
!  (ndim, nfac)    !    !     !                                                !
160
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
161
 
!  (ndim, nfabor)  !    !     !                                                !
162
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !
163
 
!  (ndim, nnod)    !    !     !                                                !
164
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !
165
105
! dt(ncelet)       ! ra ! <-- ! time step (per cell)                           !
166
106
! rtp, rtpa        ! ra ! <-- ! calculated variables at cell centers           !
167
107
!  (ncelet, *)     !    !     !  (at current and previous time steps)          !
170
110
! propfb(nfabor, *)! ra ! <-- ! physical properties at boundary face centers   !
171
111
! coefa, coefb     ! ra ! <-- ! boundary conditions                            !
172
112
!  (nfabor, *)     !    !     !                                                !
173
 
! w1...8(ncelet    ! tr ! --- ! tableau de travail                             !
174
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
175
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
176
 
! ra(*)            ! ra ! --- ! main real work array                           !
177
113
!__________________!____!_____!________________________________________________!
178
114
 
179
115
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
182
118
!            --- tableau de travail
183
119
!===============================================================================
184
120
 
 
121
!===============================================================================
 
122
! Module files
 
123
!===============================================================================
 
124
 
 
125
use paramx
 
126
use numvar
 
127
use optcal
 
128
use cstphy
 
129
use cstnum
 
130
use entsor
 
131
use parall
 
132
use ppppar
 
133
use ppthch
 
134
use coincl
 
135
use cpincl
 
136
use ppincl
 
137
use ppcpfu
 
138
use mesh
 
139
 
 
140
!===============================================================================
 
141
 
185
142
implicit none
186
143
 
187
 
!===============================================================================
188
 
! Common blocks
189
 
!===============================================================================
190
 
 
191
 
include "paramx.h"
192
 
include "numvar.h"
193
 
include "optcal.h"
194
 
include "cstphy.h"
195
 
include "cstnum.h"
196
 
include "entsor.h"
197
 
include "parall.h"
198
 
include "ppppar.h"
199
 
include "ppthch.h"
200
 
include "coincl.h"
201
 
include "cpincl.h"
202
 
include "ppincl.h"
203
 
include "ppcpfu.h"
204
 
 
205
 
!===============================================================================
206
 
 
207
144
! Arguments
208
145
 
209
 
integer          idbia0 , idbra0
210
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
211
 
integer          nfml   , nprfml
212
 
integer          nnod   , lndfac , lndfbr , ncelbr
213
 
integer          nvar   , nscal  , nphas
214
 
integer          nideve , nrdeve , nituse , nrtuse , nphmx
 
146
integer          nvar   , nscal
215
147
 
216
 
integer          ifacel(2,nfac) , ifabor(nfabor)
217
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
218
 
integer          iprfml(nfml,nprfml)
219
 
integer          ipnfac(nfac+1), nodfac(lndfac)
220
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr), ibrom(nphmx)
 
148
integer          ibrom
221
149
integer          izfppp(nfabor)
222
 
integer          idevel(nideve), ituser(nituse), ia(*)
223
150
 
224
 
double precision xyzcen(ndim,ncelet)
225
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
226
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
227
 
double precision xyznod(ndim,nnod), volume(ncelet)
228
151
double precision dt(ncelet), rtp(ncelet,*), rtpa(ncelet,*)
229
152
double precision propce(ncelet,*)
230
153
double precision propfa(nfac,*), propfb(nfabor,*)
231
154
double precision coefa(nfabor,*), coefb(nfabor,*)
232
155
 
233
 
double precision f3max(ncelet)
234
 
 
235
 
double precision w1(ncelet),w2(ncelet),w3(ncelet),w4(ncelet)
236
 
double precision w5(ncelet),w6(ncelet),w7(ncelet),w8(ncelet)
237
 
double precision w9(ncelet),w10(ncelet)
238
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
239
 
 
240
156
! Local variables
241
157
 
242
 
integer          idebia, idebra
243
 
integer          ntbcpi, icpwi, ntbcpr, icpwr
244
 
integer          ntbmci, imcwi, ntbmcr, imcwr
245
 
integer          ntbwoi, iwori, ntbwor, iworr
246
 
integer          ifinia, ifinra
247
 
integer          iel, icha, icla, iphas, ipcrom, ipcro2
 
158
integer          ntbcpi, ntbcpr
 
159
integer          ntbmci, ntbmcr
 
160
integer          ntbwoi, ntbwor
 
161
integer          iel, icha, icla, ipcrom, ipcro2
248
162
integer          izone, ifac
249
163
integer          ipbrom, ipcx2c, iromf , ioxy
250
164
 
252
166
double precision x2tot, wmolme, unsro1
253
167
double precision ff4min,ff4max
254
168
 
 
169
double precision, allocatable, dimension(:) :: f3max
 
170
double precision, allocatable, dimension(:) :: w1, w2, w3
 
171
double precision, allocatable, dimension(:) :: w4, w5, w6
 
172
double precision, allocatable, dimension(:) :: w7, w8, w9
 
173
double precision, allocatable, dimension(:) :: w10
 
174
 
255
175
integer       ipass
256
176
data          ipass /0/
257
177
save          ipass
267
187
! 1. INITIALISATIONS A CONSERVER
268
188
!===============================================================================
269
189
 
 
190
! Allocate work arrays
 
191
allocate(f3max(ncelet))
 
192
allocate(w1(ncelet), w2(ncelet), w3(ncelet))
 
193
allocate(w4(ncelet), w5(ncelet), w6(ncelet))
 
194
allocate(w7(ncelet), w8(ncelet), w9(ncelet))
 
195
allocate(w10(ncelet))
 
196
 
270
197
! --- Initialisation memoire
271
198
 
272
 
idebia = idbia0
273
 
idebra = idbra0
274
199
 
275
200
! --- Initialisation des tableaux de travail
276
201
 
410
335
  w8(iel) = (rtp(iel,isca(ihm))+w8(iel))/ ( 1.d0+w1(iel) )
411
336
enddo
412
337
 
413
 
! --- Gestion memoire
414
 
!     Autres tableaux
415
 
 
416
338
! ------ Macro tableau d'entiers TBCPI : NTBCPI
417
339
!        Macro tableau de reels  TBCPR : NTBCPR
418
340
!        Macro tableau d'entiers TBMCI : NTBMCI
430
352
ntbwoi = 1
431
353
ntbwor = 4
432
354
 
433
 
call memcp1                                                       &
434
 
!==========
435
 
 ( idebia , idebra ,                                              &
436
 
   nvar   , ncelet , ncel   , nfac   , nfabor ,                   &
437
 
   ntbcpi , icpwi  ,                                              &
438
 
   ntbcpr , icpwr  ,                                              &
439
 
   ntbmci , imcwi  ,                                              &
440
 
   ntbmcr , imcwr  ,                                              &
441
 
   ntbwoi , iwori  ,                                              &
442
 
   ntbwor , iworr  ,                                              &
443
 
   ifinia , ifinra )
444
 
 
445
355
call cpphy1                                                       &
446
356
!==========
447
 
 ( ifinia , ifinra ,                                              &
448
 
   ncelet , ncel   ,                                              &
 
357
 ( ncelet , ncel   ,                                              &
449
358
   ntbcpi , ntbcpr , ntbmci , ntbmcr , ntbwoi , ntbwor ,          &
450
359
   w2     , w3     , w4     , w5     , w6    ,                    &
451
360
!         F1M      F2M      F3M      F4M      F5M
453
362
!         F6M      F7M      F4P2M
454
363
   w8     ,                                                       &
455
364
!         ENTH
456
 
   rtp    , propce  , propce(1,iromf) ,                           &
 
365
   rtp    , propce  , propce(1,iromf) )
457
366
!                          ---------------- (masse vol. gaz)
458
 
   ia(icpwi) , ra(icpwr) ,                                        &
459
 
   ia(imcwi) , ra(imcwr) ,                                        &
460
 
   ia(iwori) , ra(iworr)  )
461
367
 
462
368
!===============================================================================
463
369
! 4. CALCUL DES PROPRIETES PHYSIQUES DE LA PHASE DISPERSEE
500
406
!       a partir du premier passage si on est en suite de calcul et
501
407
!         qu'on a relu la masse volumique dans le fichier suite.
502
408
 
503
 
iphas = 1
504
 
ipcrom = ipproc(irom(iphas))
 
409
ipcrom = ipproc(irom)
505
410
 
506
 
if (ipass.gt.1.or.(isuite.eq.1.and.initro(iphas).eq.1)) then
 
411
if (ipass.gt.1.or.(isuite.eq.1.and.initro.eq.1)) then
507
412
  srrom1 = srrom
508
413
else
509
414
  srrom1 = 0.d0
530
435
!                      ----------------
531
436
!===============================================================================
532
437
 
533
 
iphas = 1
534
 
ibrom(iphas) = 1
535
 
ipbrom = ipprob(irom(iphas))
536
 
ipcrom = ipproc(irom(iphas))
 
438
ibrom = 1
 
439
ipbrom = ipprob(irom)
 
440
ipcrom = ipproc(irom)
537
441
 
538
442
! ---> Masse volumique au bord pour toutes les facettes
539
443
!      Les facettes d'entree seront recalculees.
567
471
                 +wmole(ih2o)*oxyh2o(ioxy)                        &
568
472
                 +wmole(ico2)*oxyco2(ioxy) )
569
473
 
570
 
        unsro1 = (wmolme*rr*timpat(izone)) / p0(iphas)
 
474
        unsro1 = (wmolme*rr*timpat(izone)) / p0
571
475
        x1sro1 = (1.d0-x2tot) * unsro1
572
476
        propfb(ifac,ipbrom) = 1.d0 / (x1sro1+x2sro2)
573
477
      endif
576
480
  enddo
577
481
endif
578
482
 
 
483
! Free memory
 
484
deallocate(f3max)
 
485
deallocate(w1, w2, w3)
 
486
deallocate(w4, w5, w6)
 
487
deallocate(w7, w8, w9)
 
488
deallocate(w10)
 
489
 
579
490
!----
580
491
! FIN
581
492
!----