← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/cogz/d3pini.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/cogz/d3pini.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 d3pini &
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 ,                            &
36
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml , maxelt , lstelt , &
37
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
38
 
   idevel , ituser , ia     ,                                     &
39
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
40
 
   dt     , rtp    , propce , propfa , propfb , coefa  , coefb  , &
41
 
   rdevel , rtuser , ra     )
 
26
 ( nvar   , nscal  ,                                              &
 
27
   dt     , rtp    , propce , propfa , propfb , coefa  , coefb  )
42
28
 
43
29
!===============================================================================
44
30
! FONCTION :
67
53
!     PROPCE (prop au centre), PROPFA (aux faces internes),
68
54
!     PROPFB (prop aux faces de bord)
69
55
!     Ainsi,
70
 
!      PROPCE(IEL,IPPROC(IROM  (IPHAS))) designe ROM   (IEL ,IPHAS)
71
 
!      PROPCE(IEL,IPPROC(IVISCL(IPHAS))) designe VISCL (IEL ,IPHAS)
72
 
!      PROPCE(IEL,IPPROC(ICP   (IPHAS))) designe CP    (IEL ,IPHAS)
 
56
!      PROPCE(IEL,IPPROC(IROM  )) designe ROM   (IEL)
 
57
!      PROPCE(IEL,IPPROC(IVISCL)) designe VISCL (IEL)
 
58
!      PROPCE(IEL,IPPROC(ICP   )) designe CP    (IEL)
73
59
!      PROPCE(IEL,IPPROC(IVISLS(ISCAL))) designe VISLS (IEL ,ISCAL)
74
60
 
75
61
!      PROPFA(IFAC,IPPROF(IFLUMA(IVAR ))) designe FLUMAS(IFAC,IVAR)
76
62
 
77
 
!      PROPFB(IFAC,IPPROB(IROM  (IPHAS))) designe ROMB  (IFAC,IPHAS)
 
63
!      PROPFB(IFAC,IPPROB(IROM  )) designe ROMB  (IFAC)
78
64
!      PROPFB(IFAC,IPPROB(IFLUMA(IVAR ))) designe FLUMAB(IFAC,IVAR)
79
65
 
80
66
! LA MODIFICATION DES PROPRIETES PHYSIQUES (ROM, VISCL, VISCLS, CP)
85
71
!__________________.____._____.________________________________________________.
86
72
! name             !type!mode ! role                                           !
87
73
!__________________!____!_____!________________________________________________!
88
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
89
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
90
 
! ndim             ! i  ! <-- ! spatial dimension                              !
91
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
92
 
! ncel             ! i  ! <-- ! number of cells                                !
93
 
! nfac             ! i  ! <-- ! number of interior faces                       !
94
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
95
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
96
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
97
 
! nnod             ! i  ! <-- ! number of vertices                             !
98
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
99
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
100
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
101
74
! nvar             ! i  ! <-- ! total number of variables                      !
102
75
! nscal            ! i  ! <-- ! total number of scalars                        !
103
 
! nphas            ! i  ! <-- ! number of phases                               !
104
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
105
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
106
 
! ifacel(2, nfac)  ! ia ! <-- ! interior faces -> cells connectivity           !
107
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
108
 
! ifmfbr(nfabor)   ! ia ! <-- ! boundary face family numbers                   !
109
 
! ifmcel(ncelet)   ! ia ! <-- ! cell family numbers                            !
110
 
! iprfml           ! ia ! <-- ! property numbers per family                    !
111
 
!  (nfml, nprfml)  !    !     !                                                !
112
 
! maxelt           ! i  ! <-- ! max number of cells and faces (int/boundary)   !
113
 
! lstelt(maxelt)   ! ia ! --- ! work array                                     !
114
 
! ipnfac(nfac+1)   ! ia ! <-- ! interior faces -> vertices index (optional)    !
115
 
! nodfac(lndfac)   ! ia ! <-- ! interior faces -> vertices list (optional)     !
116
 
! ipnfbr(nfabor+1) ! ia ! <-- ! boundary faces -> vertices index (optional)    !
117
 
! nodfbr(lndfbr)   ! ia ! <-- ! boundary faces -> vertices list (optional)     !
118
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
119
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
120
 
! ia(*)            ! ia ! --- ! main integer work array                        !
121
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
122
 
!  (ndim, ncelet)  !    !     !                                                !
123
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
124
 
!  (ndim, nfac)    !    !     !                                                !
125
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
126
 
!  (ndim, nfabor)  !    !     !                                                !
127
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
128
 
!  (ndim, nfac)    !    !     !                                                !
129
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
130
 
!  (ndim, nfabor)  !    !     !                                                !
131
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !
132
 
!  (ndim, nnod)    !    !     !                                                !
133
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !
134
76
! dt(ncelet)       ! tr ! <-- ! valeur du pas de temps                         !
135
77
! rtp              ! tr ! <-- ! variables de calcul au centre des              !
136
78
! (ncelet,*)       !    !     !    cellules                                    !
139
81
! propfb(nfabor, *)! ra ! <-- ! physical properties at boundary face centers   !
140
82
! coefa coefb      ! tr ! <-- ! conditions aux limites aux                     !
141
83
!  (nfabor,*)      !    !     !    faces de bord                               !
142
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
143
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
144
 
! ra(*)            ! ra ! --- ! main real work array                           !
145
84
!__________________!____!_____!________________________________________________!
146
85
 
147
86
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
150
89
!            --- tableau de travail
151
90
!===============================================================================
152
91
 
 
92
!===============================================================================
 
93
! Module files
 
94
!===============================================================================
 
95
 
 
96
use paramx
 
97
use numvar
 
98
use optcal
 
99
use cstphy
 
100
use cstnum
 
101
use entsor
 
102
use parall
 
103
use period
 
104
use ppppar
 
105
use ppthch
 
106
use coincl
 
107
use cpincl
 
108
use ppincl
 
109
use mesh
 
110
 
 
111
!===============================================================================
 
112
 
153
113
implicit none
154
114
 
155
 
!===============================================================================
156
 
! Common blocks
157
 
!===============================================================================
158
 
 
159
 
include "paramx.h"
160
 
include "numvar.h"
161
 
include "optcal.h"
162
 
include "cstphy.h"
163
 
include "cstnum.h"
164
 
include "entsor.h"
165
 
include "parall.h"
166
 
include "period.h"
167
 
include "ppppar.h"
168
 
include "ppthch.h"
169
 
include "coincl.h"
170
 
include "cpincl.h"
171
 
include "ppincl.h"
172
 
 
173
 
!===============================================================================
174
 
 
175
 
integer          idbia0 , idbra0
176
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
177
 
integer          nfml   , nprfml
178
 
integer          nnod   , lndfac , lndfbr , ncelbr
179
 
integer          nvar   , nscal  , nphas
180
 
integer          nideve , nrdeve , nituse , nrtuse
181
 
 
182
 
integer          ifacel(2,nfac) , ifabor(nfabor)
183
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
184
 
integer          iprfml(nfml,nprfml), maxelt, lstelt(maxelt)
185
 
integer          ipnfac(nfac+1), nodfac(lndfac)
186
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr)
187
 
integer          idevel(nideve), ituser(nituse), ia(*)
188
 
 
189
 
double precision xyzcen(ndim,ncelet)
190
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
191
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
192
 
double precision xyznod(ndim,nnod), volume(ncelet)
 
115
integer          nvar   , nscal
 
116
 
 
117
 
193
118
double precision dt(ncelet), rtp(ncelet,*), propce(ncelet,*)
194
119
double precision propfa(nfac,*), propfb(nfabor,*)
195
120
double precision coefa(nfabor,*), coefb(nfabor,*)
196
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
197
121
 
198
122
! Local variables
199
123
 
200
124
character*80     chaine
201
 
integer          idebia, idebra
202
 
integer          iel, igg, iphas, mode
203
 
integer          iscal, ivar, ii, idimte, itenso
 
125
integer          iel, igg, mode
 
126
integer          iscal, ivar, ii
204
127
double precision coefg(ngazgm), hair, tinitk
205
128
double precision valmax, valmin
206
129
 
217
140
 
218
141
ipass = ipass + 1
219
142
 
220
 
idebia = idbia0
221
 
idebra = idbra0
222
143
 
223
144
do igg = 1, ngazgm
224
145
  coefg(igg) = zero
225
146
enddo
226
147
 
227
 
iphas    = 1
228
 
 
229
 
 
230
148
!===============================================================================
231
149
! 2. INITIALISATION DES INCONNUES :
232
150
!      UNIQUEMENT SI ON NE FAIT PAS UNE SUITE
241
159
 
242
160
! ----- Calcul de l'enthalpie de l'air HAIR a TINITK
243
161
 
244
 
    tinitk   = t0(iphas)
 
162
    tinitk   = t0
245
163
    coefg(1) = zero
246
164
    coefg(2) = 1.d0
247
165
    coefg(3) = zero
299
217
 
300
218
    call usd3pi                                                   &
301
219
    !==========
302
 
 ( idebia , idebra ,                                              &
303
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
304
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
305
 
   nvar   , nscal  , nphas  ,                                     &
306
 
   nideve , nrdeve , nituse , nrtuse ,                            &
307
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml , maxelt , lstelt , &
308
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
309
 
   idevel , ituser , ia     ,                                     &
310
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
311
 
   dt     , rtp    , propce , propfa , propfb , coefa  , coefb  , &
312
 
   rdevel , rtuser , ra     )
 
220
 ( nvar   , nscal  ,                                              &
 
221
   dt     , rtp    , propce , propfa , propfb , coefa  , coefb  )
313
222
 
314
223
! ----- En periodique et en parallele,
315
224
!       il faut echanger ces initialisations
316
225
 
317
 
!     Parallele
318
 
    if(irangp.ge.0) then
319
 
      call parcom(rtp(1,isca(ifm  )))
320
 
      !==========
321
 
      call parcom(rtp(1,isca(ifp2m)))
322
 
      !==========
323
 
      if ( ippmod(icod3p).eq.1 ) then
324
 
        call parcom(rtp(1,isca(ihm  )))
325
 
        !==========
326
 
      endif
327
 
    endif
328
 
 
329
 
!     Periodique
330
 
    if(iperio.eq.1) then
331
 
      idimte = 0
332
 
      itenso = 0
333
 
      ivar   = isca(ifm  )
334
 
      call percom                                                 &
335
 
      !==========
336
 
      ( idimte , itenso ,                                         &
337
 
        rtp(1,ivar), rtp(1,ivar), rtp(1,ivar),                    &
338
 
        rtp(1,ivar), rtp(1,ivar), rtp(1,ivar),                    &
339
 
        rtp(1,ivar), rtp(1,ivar), rtp(1,ivar))
340
 
      idimte = 0
341
 
      itenso = 0
342
 
      ivar   = isca(ifp2m)
343
 
      call percom                                                 &
344
 
      !==========
345
 
      ( idimte , itenso ,                                         &
346
 
        rtp(1,ivar), rtp(1,ivar), rtp(1,ivar),                    &
347
 
        rtp(1,ivar), rtp(1,ivar), rtp(1,ivar),                    &
348
 
        rtp(1,ivar), rtp(1,ivar), rtp(1,ivar))
349
 
      if ( ippmod(icod3p).eq.1 ) then
350
 
        idimte = 0
351
 
        itenso = 0
352
 
        ivar   = isca(ihm  )
353
 
        call percom                                               &
354
 
        !==========
355
 
      ( idimte , itenso ,                                         &
356
 
        rtp(1,ivar), rtp(1,ivar), rtp(1,ivar),                    &
357
 
        rtp(1,ivar), rtp(1,ivar), rtp(1,ivar),                    &
358
 
        rtp(1,ivar), rtp(1,ivar), rtp(1,ivar))
 
226
    if (irangp.ge.0.or.iperio.eq.1) then
 
227
      call synsca(rtp(1,isca(ifm)))
 
228
      !==========
 
229
      call synsca(rtp(1,isca(ifp2m)))
 
230
      !==========
 
231
      if ( ippmod(icod3p).eq.1 ) then
 
232
        call synsca(rtp(1,isca(ihm)))
 
233
        !==========
359
234
      endif
360
235
    endif
361
236