← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/elec/elphyv.f90

  • Committer: Package Import Robot
  • Author(s): Sylvestre Ledru
  • Date: 2011-11-01 17:43:32 UTC
  • mto: (6.1.7 sid)
  • mto: This revision was merged to the branch mainline in revision 11.
  • Revision ID: package-import@ubuntu.com-20111101174332-tl4vk45no0x3emc3
Tags: upstream-2.1.0
Import upstream version 2.1.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/elec/elphyv.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 elphyv &
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
 
   w1     , w2     , w3     , w4     ,                            &
43
 
   w5     , w6     , w7     , w8     ,                            &
44
 
   rdevel , rtuser , ra     )
 
29
   coefa  , coefb  )
45
30
 
46
31
!===============================================================================
47
32
! FONCTION :
70
55
!  (une routine specifique est dediee a cela : usvist)
71
56
 
72
57
 
73
 
!  Il FAUT AVOIR PRECISE ICP(IPHAS) = 1
 
58
!  Il FAUT AVOIR PRECISE ICP = 1
74
59
!     ==================
75
60
!    dans usini1 si on souhaite imposer une chaleur specifique
76
 
!    CP variable pour la phase IPHAS (sinon: ecrasement memoire).
 
61
!    CP variable (sinon: ecrasement memoire).
77
62
 
78
63
 
79
64
!  Il FAUT AVOIR PRECISE IVISLS(Numero de scalaire) = 1
92
77
!    Ainsi, AU PREMIER PAS DE TEMPS (calcul non suite), les seules
93
78
!    grandeurs initialisees avant appel sont celles donnees
94
79
!      - dans usini1 :
95
 
!             . la masse volumique (initialisee a RO0(IPHAS))
96
 
!             . la viscosite       (initialisee a VISCL0(IPHAS))
 
80
!             . la masse volumique (initialisee a RO0)
 
81
!             . la viscosite       (initialisee a VISCL0)
97
82
!      - dans usiniv :
98
83
!             . les variables de calcul  (initialisees a 0 par defaut
99
84
!             ou a la valeur donnee dans usiniv)
117
102
!__________________.____._____.________________________________________________.
118
103
! name             !type!mode ! role                                           !
119
104
!__________________!____!_____!________________________________________________!
120
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
121
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
122
 
! ndim             ! i  ! <-- ! spatial dimension                              !
123
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
124
 
! ncel             ! i  ! <-- ! number of cells                                !
125
 
! nfac             ! i  ! <-- ! number of interior faces                       !
126
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
127
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
128
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
129
 
! nnod             ! i  ! <-- ! number of vertices                             !
130
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
131
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
132
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
133
105
! nvar             ! i  ! <-- ! total number of variables                      !
134
106
! nscal            ! i  ! <-- ! total number of scalars                        !
135
 
! nphas            ! i  ! <-- ! number of phases                               !
136
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
137
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
138
 
! nphmx            ! e  ! <-- ! nphsmx                                         !
139
 
! ifacel(2, nfac)  ! ia ! <-- ! interior faces -> cells connectivity           !
140
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
141
 
! ifmfbr(nfabor)   ! ia ! <-- ! boundary face family numbers                   !
142
 
! ifmcel(ncelet)   ! ia ! <-- ! cell family numbers                            !
143
 
! iprfml           ! ia ! <-- ! property numbers per family                    !
144
 
!  (nfml, nprfml)  !    !     !                                                !
145
 
! ipnfac(nfac+1)   ! ia ! <-- ! interior faces -> vertices index (optional)    !
146
 
! nodfac(lndfac)   ! ia ! <-- ! interior faces -> vertices list (optional)     !
147
 
! ipnfbr(nfabor+1) ! ia ! <-- ! boundary faces -> vertices index (optional)    !
148
 
! nodfbr(lndfbr)   ! ia ! <-- ! boundary faces -> vertices list (optional)     !
149
107
! ibrom            ! te ! <-- ! indicateur de remplissage de romb              !
150
 
!   (nphmx   )     !    !     !                                                !
 
108
!        !    !     !                                                !
151
109
! izfppp           ! te ! <-- ! numero de zone de la face de bord              !
152
110
! (nfabor)         !    !     !  pour le module phys. part.                    !
153
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
154
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
155
 
! ia(*)            ! ia ! --- ! main integer work array                        !
156
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
157
 
!  (ndim, ncelet)  !    !     !                                                !
158
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
159
 
!  (ndim, nfac)    !    !     !                                                !
160
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
161
 
!  (ndim, nfabor)  !    !     !                                                !
162
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
163
 
!  (ndim, nfac)    !    !     !                                                !
164
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
165
 
!  (ndim, nfabor)  !    !     !                                                !
166
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !
167
 
!  (ndim, nnod)    !    !     !                                                !
168
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !
169
111
! dt(ncelet)       ! ra ! <-- ! time step (per cell)                           !
170
112
! rtp, rtpa        ! ra ! <-- ! calculated variables at cell centers           !
171
113
!  (ncelet, *)     !    !     !  (at current and previous time steps)          !
174
116
! propfb(nfabor, *)! ra ! <-- ! physical properties at boundary face centers   !
175
117
! coefa, coefb     ! ra ! <-- ! boundary conditions                            !
176
118
!  (nfabor, *)     !    !     !                                                !
177
 
! w1...8(ncelet    ! tr ! --- ! tableau de travail                             !
178
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
179
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
180
 
! ra(*)            ! ra ! --- ! main real work array                           !
181
119
!__________________!____!_____!________________________________________________!
182
120
 
183
121
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
186
124
!            --- tableau de travail
187
125
!===============================================================================
188
126
 
 
127
!===============================================================================
 
128
! Module files
 
129
!===============================================================================
 
130
 
 
131
use paramx
 
132
use numvar
 
133
use optcal
 
134
use cstnum
 
135
use cstphy
 
136
use entsor
 
137
use ppppar
 
138
use ppthch
 
139
use ppincl
 
140
use elincl
 
141
use mesh
 
142
 
 
143
!===============================================================================
 
144
 
189
145
implicit none
190
146
 
191
 
!===============================================================================
192
 
! Common blocks
193
 
!===============================================================================
194
 
 
195
 
include "paramx.h"
196
 
include "numvar.h"
197
 
include "optcal.h"
198
 
include "cstnum.h"
199
 
include "cstphy.h"
200
 
include "entsor.h"
201
 
include "ppppar.h"
202
 
include "ppthch.h"
203
 
include "ppincl.h"
204
 
include "elincl.h"
205
 
 
206
 
!===============================================================================
207
 
 
208
147
! Arguments
209
148
 
210
 
integer          idbia0 , idbra0
211
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
212
 
integer          nfml   , nprfml
213
 
integer          nnod   , lndfac , lndfbr , ncelbr
214
 
integer          nvar   , nscal  , nphas
215
 
integer          nideve , nrdeve , nituse , nrtuse , nphmx
 
149
integer          nvar   , nscal
216
150
 
217
 
integer          ifacel(2,nfac) , ifabor(nfabor)
218
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
219
 
integer          iprfml(nfml,nprfml)
220
 
integer          ipnfac(nfac+1), nodfac(lndfac)
221
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr), ibrom(nphmx)
 
151
integer          ibrom
222
152
integer          izfppp(nfabor)
223
 
integer          idevel(nideve), ituser(nituse), ia(*)
224
153
 
225
 
double precision xyzcen(ndim,ncelet)
226
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
227
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
228
 
double precision xyznod(ndim,nnod), volume(ncelet)
229
154
double precision dt(ncelet), rtp(ncelet,*), rtpa(ncelet,*)
230
155
double precision propce(ncelet,*)
231
156
double precision propfa(nfac,*), propfb(nfabor,*)
232
157
double precision coefa(nfabor,*), coefb(nfabor,*)
233
 
double precision w1(ncelet),w2(ncelet),w3(ncelet),w4(ncelet)
234
 
double precision w5(ncelet),w6(ncelet),w7(ncelet),w8(ncelet)
235
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
236
158
 
237
159
! Local variables
238
160
 
239
 
integer          idebia, idebra, ifinia
240
 
integer          iel   , iphas
 
161
integer          iel
241
162
integer          ipcrom, ipcvis, ipccp , ipcray
242
163
integer          ipcvsl, ith   , iscal , ii
243
164
integer          iiii  , ipcsig, it
244
165
integer          iesp  , iesp1 , iesp2 , mode , isrrom
245
 
integer          maxelt, ils
246
166
 
247
167
double precision tp    , delt  , somphi, val
248
168
double precision alpro , alpvis, alpcp , alpsig, alplab , alpkab
261
181
! 0 - INITIALISATIONS A CONSERVER
262
182
!===============================================================================
263
183
 
 
184
! Initialize variables to avoid compiler warnings
 
185
 
 
186
ipccp = 0
 
187
ipcvsl = 0
 
188
ipcsig = 0
 
189
ipcray = 0
 
190
 
264
191
! --- Initialisation memoire
265
192
 
266
 
idebia = idbia0
267
 
idebra = idbra0
268
193
 
269
194
ipass = ipass + 1
270
195
 
271
 
iphas = 1
272
 
 
273
196
!     Sous relaxation de la masse volumique (pas au premier pas de temps)
274
197
if(ntcabs.gt.1.and.srrom.gt.0.d0) then
275
198
  isrrom = 1
294
217
 
295
218
!       On n'utilisera donc PAS les variables
296
219
!          =====================
297
 
!                                CP0(IPHAS), VISLS0(ISCALT(IPHAS))
 
220
!                                CP0, VISLS0(ISCALT)
298
221
!                                VISLS0(IPOTR) et VISLS0(IPOTI)
299
222
 
300
223
!       Informatiquement, ceci se traduit par le fait que
301
 
!                                ICP(IPHAS)>0, IVISLS(ISCALT(IPHAS))>0,
 
224
!                                ICP>0, IVISLS(ISCALT)>0,
302
225
!                                IVISLS(IPOTR)>0 et IVISLS(IPOTI)>0
303
226
 
304
227
!       Les verifications ont ete faites dans elveri
308
231
!       n'en avoir qu'une seule (modif dans varpos pour definir
309
232
!       IVISLS(IPOTI) = IVISLS(IPOTR)) et economiser NCEL reels .
310
233
 
311
 
!      IPCROM = IPPROC(IROM(IPHAS))
312
 
!      IPCVIS = IPPROC(IVISCL(IPHAS))
313
 
!      IPCCP  = IPPROC(ICP(IPHAS))
314
 
!      IPCVSL = IPPROC(IVISLS(ISCALT(IPHAS)))
 
234
!      IPCROM = IPPROC(IROM)
 
235
!      IPCVIS = IPPROC(IVISCL)
 
236
!      IPCCP  = IPPROC(ICP)
 
237
!      IPCVSL = IPPROC(IVISLS(ISCALT))
315
238
!      IPCSIR = IPPROC(IVISLS(IPOTR))
316
239
!      IPCSII = IPPROC(IVISLS(IPOTI))
317
240
 
362
285
 
363
286
!      Pointeurs pour les differentes variables
364
287
 
365
 
  ipcrom = ipproc(irom(iphas))
366
 
  ipcvis = ipproc(iviscl(iphas))
367
 
  if(icp(iphas).gt.0) then
368
 
    ipccp  = ipproc(icp(iphas))
 
288
  ipcrom = ipproc(irom)
 
289
  ipcvis = ipproc(iviscl)
 
290
  if(icp.gt.0) then
 
291
    ipccp  = ipproc(icp)
369
292
  endif
370
 
  if(ivisls(iscalt(iphas)).gt.0) then
371
 
    ipcvsl = ipproc(ivisls(iscalt(iphas)))
 
293
  if(ivisls(iscalt).gt.0) then
 
294
    ipcvsl = ipproc(ivisls(iscalt))
372
295
  endif
373
296
  if ( ivisls(ipotr).gt.0 ) then
374
297
    ipcsig = ipproc(ivisls(ipotr))
543
466
!       Chaleur specifique J/(kg degres)
544
467
!       ================================
545
468
 
546
 
    if(icp(iphas).gt.0) then
 
469
    if(icp.gt.0) then
547
470
 
548
471
      propce(iel,ipccp) = 0.d0
549
472
      do iesp = 1, ngazg
556
479
!       Lambda/Cp en kg/(m s)
557
480
!       ---------------------
558
481
 
559
 
    if(ivisls(iscalt(iphas)).gt.0) then
 
482
    if(ivisls(iscalt).gt.0) then
560
483
 
561
484
      do iesp1=1,ngazg
562
485
        do iesp2=1,ngazg
591
514
 
592
515
      if(ipccp.le.0) then
593
516
 
594
 
! --- Si CP est uniforme, on utilise CP0(IPHAS)
 
517
! --- Si CP est uniforme, on utilise CP0
595
518
 
596
 
        propce(iel,ipcvsl) = propce(iel,ipcvsl)/cp0(iphas)
 
519
        propce(iel,ipcvsl) = propce(iel,ipcvsl)/cp0
597
520
 
598
521
      else
599
522
 
643
566
 
644
567
! --- Si il s'agit de l'enthalpie son cas a deja ete traite plus haut
645
568
    ith = 0
646
 
    if (iscal.eq.iscalt(iphas)) ith = 1
 
569
    if (iscal.eq.iscalt) ith = 1
647
570
 
648
571
! --- Si il s'agit de Potentiel (IPOTR), son cas a deja ete traite
649
572
    if (iscal.eq.ipotr) ith = 1
689
612
!       Masse volumique
690
613
!       ---------------
691
614
 
692
 
  ipcrom = ipproc(irom(iphas))
 
615
  ipcrom = ipproc(irom)
693
616
  do iel = 1, ncel
694
617
    propce(iel,ipcrom) = 1.d0
695
618
  enddo
697
620
!       VISCOSITE
698
621
!       =========
699
622
 
700
 
  ipcvis = ipproc(iviscl(iphas))
 
623
  ipcvis = ipproc(iviscl)
701
624
  do iel = 1, ncel
702
625
    propce(iel,ipcvis) = 1.d-2
703
626
  enddo
705
628
!       CHALEUR SPECIFIQUE VARIABLE J/(kg degres)
706
629
!       =========================================
707
630
 
708
 
  if(icp(iphas).gt.0) then
 
631
  if(icp.gt.0) then
709
632
 
710
 
    ipccp  = ipproc(icp   (iphas))
 
633
    ipccp  = ipproc(icp   )
711
634
 
712
635
    do iel = 1, ncel
713
636
      propce(iel,ipccp ) = 1000.d0
718
641
!       Lambda/CP  VARIABLE en kg/(m s)
719
642
!       ===============================
720
643
 
721
 
  if (ivisls(iscalt(iphas)).gt.0) then
 
644
  if (ivisls(iscalt).gt.0) then
722
645
 
723
 
    ipcvsl = ipproc(ivisls(iscalt(iphas)))
 
646
    ipcvsl = ipproc(ivisls(iscalt))
724
647
 
725
648
    if(ipccp.le.0) then
726
649
 
727
 
! --- Si CP est uniforme, on utilise CP0(IPHAS)
 
650
! --- Si CP est uniforme, on utilise CP0
728
651
 
729
652
      do iel = 1, ncel
730
 
        propce(iel,ipcvsl) = 1.d0/cp0(iphas)
 
653
        propce(iel,ipcvsl) = 1.d0/cp0
731
654
      enddo
732
655
 
733
656
    else
751
674
 
752
675
! --- Si il s'agit de l'enthqlpie son cas a deja ete traite plus haut
753
676
    ith = 0
754
 
    if (iscal.eq.iscalt(iphas)) ith = 1
 
677
    if (iscal.eq.iscalt) ith = 1
755
678
 
756
679
! --- Si la variable est une fluctuation, sa diffusivite est
757
680
!       la meme que celle du scalaire auquel elle est rattachee :
789
712
! 4 - ON PASSE LA MAIN A L'UTILISATEUR (joule en particulier)
790
713
!===============================================================================
791
714
 
792
 
maxelt = max(ncelet, nfac, nfabor)
793
 
ils    = idebia
794
 
ifinia = ils + maxelt
795
 
CALL IASIZE('ELPHYV',IFINIA)
796
 
 
797
715
call uselph                                                       &
798
716
!==========
799
 
 ( ifinia , idebra ,                                              &
800
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
801
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
802
 
   nvar   , nscal  , nphas  ,                                     &
803
 
   nideve , nrdeve , nituse , nrtuse , nphmx  ,                   &
804
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml , maxelt , ia(ils), &
805
 
   ipnfac , nodfac , ipnfbr , nodfbr , ibrom  , izfppp ,          &
806
 
   idevel , ituser , ia     ,                                     &
807
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
717
 ( nvar   , nscal  ,                                              &
 
718
   ibrom  , izfppp ,                                              &
808
719
   dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
809
 
   coefa  , coefb  ,                                              &
810
 
   w1     , w2     , w3     , w4     ,                            &
811
 
   w5     , w6     , w7     , w8     ,                            &
812
 
   rdevel , rtuser , ra     )
 
720
   coefa  , coefb  )
813
721
 
814
722
 
815
723