← Back to branch summary

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

« back to all changes in this revision

Viewing changes to users/lagr/uslast.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/lagr/uslast.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 uslast &
32
26
!================
33
27
 
34
 
 ( idbia0 , idbra0 ,                                              &
35
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
36
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
37
 
   nvar   , nscal  , nphas  ,                                     &
 
28
 ( nvar   , nscal  ,                                              &
38
29
   nbpmax , nvp    , nvp1   , nvep   , nivep  ,                   &
39
30
   ntersl , nvlsta , nvisbr ,                                     &
40
 
   nideve , nrdeve , nituse , nrtuse ,                            &
41
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
42
 
   ipnfac , nodfac , ipnfbr , nodfbr , itepa  ,                   &
43
 
   idevel , ituser , ia     ,                                     &
44
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
31
   itepa  ,                                                       &
45
32
   dt     , rtpa   , rtp    , propce , propfa , propfb ,          &
46
33
   coefa  , coefb  ,                                              &
47
34
   ettp   , ettpa  , tepa   , taup   , tlag   , tempct ,          &
48
 
   statis , stativ ,                                              &
49
 
   w1     , w2     , w3     ,                                     &
50
 
   rdevel , rtuser , ra     )
 
35
   statis , stativ )
51
36
 
52
37
!===============================================================================
53
38
! Purpose:
90
75
!__________________.____._____.________________________________________________.
91
76
! name             !type!mode ! role                                           !
92
77
!__________________!____!_____!________________________________________________!
93
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
94
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
95
 
! ndim             ! i  ! <-- ! spatial dimension                              !
96
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
97
 
! ncel             ! i  ! <-- ! number of cells                                !
98
 
! nfac             ! i  ! <-- ! number of interior faces                       !
99
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
100
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
101
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
102
 
! nnod             ! i  ! <-- ! number of vertices                             !
103
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
104
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
105
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
106
 
!                  !    !     !                                                !
107
78
! nvar             ! i  ! <-- ! total number of variables                      !
108
79
! nscal            ! i  ! <-- ! total number of scalars                        !
109
 
! nphas            ! i  ! <-- ! number of phases                               !
110
80
! nbpmax           ! i  ! <-- ! maximum number of particles allowed            !
111
81
! nvp              ! i  ! <-- ! number of particle variables                   !
112
82
! nvp1             ! i  ! <-- ! nvp minus position, fluid and part. velocities !
115
85
! ntersl           ! i  ! <-- ! number of source terms of return coupling      !
116
86
! nvlsta           ! i  ! <-- ! nb of Lagrangian statistical variables         !
117
87
! nvisbr           ! i  ! <-- ! number of boundary statistics                  !
118
 
! nideve nrdeve    ! i  ! <-- ! sizes of idevel and rdevel arrays              !
119
 
! nituse nrtuse    ! i  ! <-- ! sizes of ituser and rtuser arrays              !
120
 
! ifacel           ! ia ! <-- ! interior faces -> cells connectivity           !
121
 
! (2, nfac)        !    !     !                                                !
122
 
! ifabor           ! ia ! <-- ! boundary faces -> cells connectivity           !
123
 
! (nfabor)         !    !     !                                                !
124
 
! ifmfbr           ! ia ! <-- ! boundary face family numbers                   !
125
 
! (nfabor)         !    !     !                                                !
126
 
! ifmcel           ! ia ! <-- ! cell family numbers                            !
127
 
! (ncelet)         !    !     !                                                !
128
 
! iprfml           ! ia ! <-- ! property numbers per family                    !
129
 
! nfml  ,nprfml    !    !     !                                                !
130
 
! ipnfac           ! ia ! <-- ! interior faces -> vertices index (optional)    !
131
 
!   (nfac+1)       !    !     !                                                !
132
 
! nodfac           ! ia ! <-- ! interior faces -> vertices list (optional)     !
133
 
!   (lndfac)       !    !     !                                                !
134
 
! ipnfbr           ! ia ! <-- ! boundary faces -> vertices index (optional)    !
135
 
!  (nfabor+1)      !    !     !                                                !
136
 
! nodfbr           ! ia ! <-- ! boundary faces -> vertices list  (optional)    !
137
 
!   (lndfbr  )     !    !     !                                                !
138
88
! itepa            ! ia ! <-- ! particle information (integers)                !
139
89
! (nbpmax,nivep    !    !     !                                                !
140
 
! idevel(nideve    ! ia ! <-- ! complementary dev. array of integers           !
141
 
! ituser(nituse    ! ia ! <-- ! complementary user array of integers           !
142
 
! ia(*)            ! ia ! --- ! macro array of integers                        !
143
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
144
 
! (ndim,ncelet     !    !     !                                                !
145
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
146
 
! (ndim,nfac)      !    !     !                                                !
147
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
148
 
! (ndim,nfabor)    !    !     !                                                !
149
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
150
 
! (ndim,nfac)      !    !     !                                                !
151
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
152
 
! (ndim,nfabor)    !    !     !                                                !
153
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !
154
 
! (ndim,nnod)      !    !     !                                                !
155
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !
156
90
! dt(ncelet)       ! ra ! <-- ! time step (per cell)                           !
157
91
! rtp, rtpa        ! ra ! <-- ! transported variables at cell centers at       !
158
92
! (ncelet,*)       !    !     ! the current and previous time step             !
179
113
! stativ           ! ra ! <-- ! cumul. for the variance of the volume stats.   !
180
114
!(ncelet,          !    !     !                                                !
181
115
!   nvlsta-1)      !    !     !                                                !
182
 
! w1..w3(ncelet    ! ra ! --- ! work arrays                                    !
183
 
! rdevel(nrdeve    ! ra ! <-- ! dev. complementary array of reals              !
184
 
! rtuser(nrtuse    ! ra ! <-- ! user complementary array of reals              !
185
 
! ra(*)            ! ra ! --- ! macro array of reals                           !
186
116
!__________________!____!_____!________________________________________________!
187
117
 
188
118
!     Type: i (integer), r (real), s (string), a (array), l (logical),
190
120
!     mode: <-- input, --> output, <-> modifies data, --- work array
191
121
!===============================================================================
192
122
 
 
123
!===============================================================================
 
124
! Module files
 
125
!===============================================================================
 
126
 
 
127
use paramx
 
128
use numvar
 
129
use cstnum
 
130
use optcal
 
131
use pointe
 
132
use entsor
 
133
use lagpar
 
134
use lagran
 
135
use cstphy
 
136
use ppppar
 
137
use ppthch
 
138
use cpincl
 
139
use mesh
 
140
 
 
141
!===============================================================================
 
142
 
193
143
implicit none
194
144
 
195
 
!===============================================================================
196
 
!     Common blocks
197
 
!===============================================================================
198
 
 
199
 
include "paramx.h"
200
 
include "numvar.h"
201
 
include "cstnum.h"
202
 
include "optcal.h"
203
 
include "pointe.h"
204
 
include "entsor.h"
205
 
include "lagpar.h"
206
 
include "lagran.h"
207
 
include "cstphy.h"
208
 
include "ppppar.h"
209
 
include "ppthch.h"
210
 
include "cpincl.h"
211
 
 
212
 
!===============================================================================
213
 
 
214
145
! Arguments
215
146
 
216
 
integer          idbia0 , idbra0
217
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
218
 
integer          nfml   , nprfml
219
 
integer          nnod   , lndfac , lndfbr , ncelbr
220
 
integer          nvar   , nscal  , nphas
 
147
integer          nvar   , nscal
221
148
integer          nbpmax , nvp    , nvp1   , nvep  , nivep
222
149
integer          ntersl , nvlsta , nvisbr
223
 
integer          nideve , nrdeve , nituse , nrtuse
224
 
integer          ifacel(2,nfac) , ifabor(nfabor)
225
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
226
 
integer          iprfml(nfml,nprfml)
227
 
integer          ipnfac(nfac+1) , nodfac(lndfac)
228
 
integer          ipnfbr(nfabor+1) , nodfbr(lndfbr)
 
150
 
229
151
integer          itepa(nbpmax,nivep)
230
 
integer          idevel(nideve), ituser(nituse)
231
 
integer          ia(*)
232
152
 
233
 
double precision xyzcen(ndim,ncelet)
234
 
double precision surfac(ndim,nfac) , surfbo(ndim,nfabor)
235
 
double precision cdgfac(ndim,nfac) , cdgfbo(ndim,nfabor)
236
 
double precision xyznod(ndim,nnod) , volume(ncelet)
237
153
double precision dt(ncelet) , rtp(ncelet,*) , rtpa(ncelet,*)
238
154
double precision propce(ncelet,*)
239
155
double precision propfa(nfac,*) , propfb(nfabor,*)
243
159
double precision taup(nbpmax) , tlag(nbpmax,3) , tempct(nbpmax,2)
244
160
double precision statis(ncelet,nvlsta)
245
161
double precision stativ(ncelet,nvlsta-1)
246
 
double precision w1(ncelet), w2(ncelet), w3(ncelet)
247
 
double precision rdevel(nrdeve) , rtuser(nrtuse)
248
 
double precision ra(*)
249
162
 
250
163
! Local variables
251
164
 
252
 
integer          idebia , idebra
253
 
integer          ifinia, ifinra
254
 
integer          npt ,  iel , iphas
 
165
integer          npt ,  iel
255
166
 
256
 
integer          ivf , ivff , itabvr , iflu , icla
 
167
integer          ivf , ivff , iflu , icla
257
168
 
258
169
! User-defined local variables
259
170
 
265
176
integer          inoeud, irang0, indic
266
177
integer          ist(6)
267
178
 
 
179
integer, allocatable, dimension(:) :: node_mask
 
180
 
268
181
double precision zz(4), zzz(8), xlist(nxlist,8), xyzpt(3)
269
182
 
 
183
double precision, allocatable, dimension(:) :: tabvr
 
184
 
270
185
character        name(8)*4
271
186
 
272
187
double precision debm(4)
322
237
! 0.  Memory management
323
238
!===============================================================================
324
239
 
325
 
idebia = idbia0
326
 
idebra = idbra0
327
240
 
328
241
!===============================================================================
329
242
! 1. Initialization
330
243
!===============================================================================
331
244
 
332
 
iphas = ilphas
333
 
 
334
245
!===============================================================================
335
246
! 2 - Computation of user-defined particle statistics
336
247
!===============================================================================
456
367
 
457
368
    npts = nxlist
458
369
 
459
 
    ifinia = idebia
460
 
    itabvr = idebra
461
 
    ifinra = itabvr + ncelet
462
 
    CALL RASIZE('USLAST',IFINRA)
463
 
    !==========
 
370
    ! Allocate work arrays
 
371
    allocate(tabvr(ncelet))
 
372
    allocate(node_mask(nnod))
 
373
    node_mask(:) = 0
464
374
 
465
375
    do iplan = 1,8
466
376
 
480
390
 
481
391
        call uslaen                                               &
482
392
        !==========
483
 
 ( ifinia , ifinra ,                                              &
484
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
485
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
486
 
   nvar   , nscal  , nphas  , nvlsta ,                            &
487
 
   nideve , nrdeve , nituse , nrtuse ,                            &
 
393
 ( nvar   , nscal  , nvlsta ,                                     &
488
394
   ivff   , ivff   , ivff   , iflu   , ilpd   , icla   ,          &
489
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
490
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
491
 
   idevel , ituser , ia     ,                                     &
492
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
493
395
   dt     , rtpa   , rtp    , propce , propfa , propfb ,          &
494
 
   coefa  , coefb  , statis , stativ , ra(itabvr) ,               &
495
 
   rdevel , rtuser , ra     )
 
396
   coefa  , coefb  , statis , stativ , tabvr  )
496
397
 
497
398
        ind = 0
498
399
        do ii = 1, npts
505
406
          (ncelet, ncel, xyzcen,                                  &
506
407
           xyzpt(1), xyzpt(2), xyzpt(3), inoeud, irang0)
507
408
 
508
 
          indic = ituser(inoeud)
509
 
          ituser(inoeud) = 1
 
409
          indic = node_mask(inoeud)
 
410
          node_mask(inoeud) = 1
510
411
          if (indic.eq.1) then
511
412
            ind = ind +1
512
413
            xlist(ind,1) = xyzcen(1,inoeud)
513
414
            xlist(ind,2) = xyzcen(3,inoeud) * (1.d3 / 5.d0)
514
 
            xlist(ind,ivf+2) = ra(itabvr+inoeud-1)
 
415
            xlist(ind,ivf+2) = tabvr(inoeud)
515
416
          endif
516
417
        enddo
517
418
      enddo
524
425
 
525
426
    enddo
526
427
 
 
428
    ! Free memory
 
429
    deallocate(node_mask)
 
430
    deallocate(tabvr)
 
431
 
527
432
  endif
528
433
 
529
434
endif