← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/base/perinr.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/base/perinr.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 perinr &
29
24
!================
30
25
 
31
 
 ( idbia0 , idbra0 ,                                              &
32
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
33
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
34
 
   nvar   , nscal  , nphas  , iphas  ,                            &
35
 
   nideve , nrdeve , nituse , nrtuse ,                            &
36
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
37
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
38
 
   idevel , ituser , ia     ,                                     &
39
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
26
 ( nvar   , nscal  ,                                              &
40
27
   dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
41
28
   coefa  , coefb  ,                                              &
42
 
   w1     , w2     , w3     , w4     ,                            &
43
 
   w5     , w6     , w7     , w8     ,                            &
44
 
   rdevel , rtuser ,                                              &
45
 
   drdxyz  ,                                                      &
46
 
   ra     )
 
29
   drdxyz )
47
30
 
48
31
!===============================================================================
49
32
! FONCTION :
68
51
!__________________.____._____.________________________________________________.
69
52
! name             !type!mode ! role                                           !
70
53
!__________________!____!_____!________________________________________________!
71
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
72
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
73
 
! ndim             ! i  ! <-- ! spatial dimension                              !
74
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
75
 
! ncel             ! i  ! <-- ! number of cells                                !
76
 
! nfac             ! i  ! <-- ! number of interior faces                       !
77
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
78
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
79
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
80
 
! nnod             ! i  ! <-- ! number of vertices                             !
81
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
82
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
83
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
84
54
! nvar             ! i  ! <-- ! total number of variables                      !
85
55
! nscal            ! i  ! <-- ! total number of scalars                        !
86
 
! nphas            ! i  ! <-- ! number of phases                               !
87
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
88
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
89
 
! ifacel(2, nfac)  ! ia ! <-- ! interior faces -> cells connectivity           !
90
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
91
 
! ifmfbr(nfabor)   ! ia ! <-- ! boundary face family numbers                   !
92
 
! ifmcel(ncelet)   ! ia ! <-- ! cell family numbers                            !
93
 
! iprfml           ! ia ! <-- ! property numbers per family                    !
94
 
!  (nfml, nprfml)  !    !     !                                                !
95
 
! ipnfac(nfac+1)   ! ia ! <-- ! interior faces -> vertices index (optional)    !
96
 
! nodfac(lndfac)   ! ia ! <-- ! interior faces -> vertices list (optional)     !
97
 
! ipnfbr(nfabor+1) ! ia ! <-- ! boundary faces -> vertices index (optional)    !
98
 
! nodfbr(lndfbr)   ! ia ! <-- ! boundary faces -> vertices list (optional)     !
99
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
100
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
101
 
! ia(*)            ! ia ! --- ! main integer work array                        !
102
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
103
 
!  (ndim, ncelet)  !    !     !                                                !
104
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
105
 
!  (ndim, nfac)    !    !     !                                                !
106
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
107
 
!  (ndim, nfabor)  !    !     !                                                !
108
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
109
 
!  (ndim, nfac)    !    !     !                                                !
110
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
111
 
!  (ndim, nfabor)  !    !     !                                                !
112
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !
113
 
!  (ndim, nnod)    !    !     !                                                !
114
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !
115
56
! dt(ncelet)       ! ra ! <-- ! time step (per cell)                           !
116
57
! rtp, rtpa        ! ra ! <-- ! calculated variables at cell centers           !
117
58
!  (ncelet, *)     !    !     !  (at current and previous time steps)          !
120
61
! propfb(nfabor, *)! ra ! <-- ! physical properties at boundary face centers   !
121
62
! coefa, coefb     ! ra ! <-- ! boundary conditions                            !
122
63
!  (nfabor, *)     !    !     !                                                !
123
 
! w1...8(ncelet    ! tr ! --- ! tableau de travail                             !
124
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
125
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
126
64
! drdxyz           ! tr ! <-- ! gradient de r aux cellules halo pour           !
127
65
!                  !    !     ! l'approche explicite en periodicite            !
128
 
! ra(*)            ! ra ! --- ! main real work array                           !
129
66
!__________________!____!_____!________________________________________________!
130
67
 
131
68
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
134
71
!            --- tableau de travail
135
72
!===============================================================================
136
73
 
 
74
!===============================================================================
 
75
! Module files
 
76
!===============================================================================
 
77
 
 
78
use paramx
 
79
use dimens, only: ndimfb
 
80
use numvar
 
81
use optcal
 
82
use cstphy
 
83
use cstnum
 
84
use entsor
 
85
use pointe
 
86
use period
 
87
use mesh
 
88
 
 
89
!===============================================================================
 
90
 
137
91
implicit none
138
92
 
139
 
!===============================================================================
140
 
! Common blocks
141
 
!===============================================================================
142
 
 
143
 
include "dimfbr.h"
144
 
include "paramx.h"
145
 
include "numvar.h"
146
 
include "optcal.h"
147
 
include "cstphy.h"
148
 
include "cstnum.h"
149
 
include "entsor.h"
150
 
include "pointe.h"
151
 
include "period.h"
152
 
 
153
 
!===============================================================================
154
 
 
155
93
! Arguments
156
94
 
157
 
integer          idbia0 , idbra0
158
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
159
 
integer          nfml   , nprfml
160
 
integer          nnod   , lndfac , lndfbr , ncelbr
161
 
integer          nvar   , nscal  , nphas  , iphas
162
 
integer          nideve , nrdeve , nituse , nrtuse
163
 
 
164
 
integer          ifacel(2,nfac) , ifabor(nfabor)
165
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
166
 
integer          iprfml(nfml,nprfml)
167
 
integer          ipnfac(nfac+1), nodfac(lndfac)
168
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr)
169
 
integer          idevel(nideve), ituser(nituse)
170
 
integer          ia(*)
171
 
 
172
 
double precision xyzcen(ndim,ncelet)
173
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
174
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
175
 
double precision xyznod(ndim,nnod), volume(ncelet)
 
95
integer          nvar   , nscal
 
96
 
 
97
 
176
98
double precision dt(ncelet), rtp(ncelet,*), rtpa(ncelet,*)
177
99
double precision propce(ncelet,*)
178
100
double precision propfa(nfac,*), propfb(ndimfb,*)
179
101
double precision coefa(ndimfb,*), coefb(ndimfb,*)
180
 
double precision w1(ncelet),w2(ncelet),w3(ncelet),w4(ncelet)
181
 
double precision w5(ncelet),w6(ncelet),w7(ncelet),w8(ncelet)
182
 
double precision rdevel(nrdeve), rtuser(nrtuse)
183
 
double precision drdxyz(ncelet-ncel,6,3,nphas)
184
 
double precision ra(*)
 
102
double precision drdxyz(ncelet-ncel,6,3)
185
103
 
186
104
! Local variables
187
105
 
188
 
integer          idebia, idebra
189
106
integer          inc, iccocg,ipiph,nswrgp,imligp,iwarnp
190
 
integer          isou, isou1, iphydp
 
107
integer          isou, isou1
191
108
 
192
109
double precision epsrgp, climgp,extrap
193
110
 
 
111
double precision, allocatable, dimension(:,:) :: grad
 
112
 
194
113
!===============================================================================
195
114
 
196
115
!===============================================================================
197
116
! 1.  INITIALISATIONS
198
117
!===============================================================================
199
118
 
200
 
idebia = idbia0
201
 
idebra = idbra0
 
119
! Allocate a work array
 
120
allocate(grad(ncelet,3))
 
121
 
202
122
 
203
123
inc = 0
204
124
iccocg = 1
205
125
 
206
126
do isou = 1,6
207
 
  if(isou.eq.1) ipiph  = ir11(iphas)
208
 
  if(isou.eq.2) ipiph  = ir22(iphas)
209
 
  if(isou.eq.3) ipiph  = ir33(iphas)
210
 
  if(isou.eq.4) ipiph  = ir12(iphas)
211
 
  if(isou.eq.5) ipiph  = ir13(iphas)
212
 
  if(isou.eq.6) ipiph  = ir23(iphas)
 
127
  if(isou.eq.1) ipiph  = ir11
 
128
  if(isou.eq.2) ipiph  = ir22
 
129
  if(isou.eq.3) ipiph  = ir33
 
130
  if(isou.eq.4) ipiph  = ir12
 
131
  if(isou.eq.5) ipiph  = ir13
 
132
  if(isou.eq.6) ipiph  = ir23
213
133
 
214
134
 
215
135
! On ne reconstruit pas et on ne limite pas car
234
154
  epsrgp = epsrgr(ipiph)
235
155
  climgp = climgr(ipiph)
236
156
  extrap = extrag(ipiph)
237
 
  iphydp = 0
238
157
 
239
158
  call grdcel                                                     &
240
159
  !==========
241
 
 ( idebia , idebra ,                                              &
242
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
243
 
   nnod   , lndfac , lndfbr , ncelbr , nphas  ,                   &
244
 
   nideve , nrdeve , nituse , nrtuse ,                            &
245
 
   ipiph  , imrgra , inc    , iccocg , nswrgp , imligp , iphydp , &
 
160
 ( ipiph  , imrgra , inc    , iccocg , nswrgp , imligp ,          &
246
161
   iwarnp , nfecra , epsrgp , climgp , extrap ,                   &
247
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
248
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
249
 
   idevel , ituser , ia     ,                                     &
250
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
251
 
   w1     , w1     , w1     ,                                     &
252
162
   rtp(1,ipiph)  , coefa(1,ipiph) , coefb(1,ipiph) ,              &
253
 
   w1     , w2     , w3     ,                                     &
254
 
!        ------   ------   ------
255
 
   w4     , w5     , w6     ,                                     &
256
 
   rdevel , rtuser , ra     )
 
163
   grad   )
257
164
 
258
165
  isou1 = isou
259
166
  call peinr1                                                     &
260
167
  !==========
261
 
  ( isou1  , iphas   ,                                            &
 
168
  ( isou1  ,                                                      &
262
169
    drdxyz ,                                                      &
263
 
    w1     , w2      , w3     )
 
170
    grad(1,1) , grad(1,2) , grad(1,3) )
264
171
 
265
172
enddo
266
173
 
267
174
! --> ON FAIT TOURNER LE TENSEUR DRDXYZ PAR MANQUE DE TABLEAUX DE
268
175
!     TRAVAIL (ON A LE MEME PROBLEME POUR U)
269
176
 
270
 
call peinr2                                                       &
 
177
call peinr2  ( drdxyz )
271
178
!==========
272
 
  ( iphas  , drdxyz )
273
179
 
274
180
! On a calcule les gradients dans DRDXYZ
275
181
igrper = 1
276
182
 
 
183
! Free memory
 
184
deallocate(grad)
277
185
 
278
186
!----
279
187
! FIN