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

« back to all changes in this revision

Viewing changes to src/lagr/lagipn.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:
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 lagipn &
29
24
!================
30
25
 
31
 
 ( idbia0 , idbra0 ,                                              &
32
 
   ncelet , ncel   ,                                              &
 
26
 ( ncelet , ncel   ,                                              &
33
27
   nbpmax , nvp    , nvp1   , nvep   , nivep  ,                   &
34
28
   npar1  , npar2  ,                                              &
35
 
   nideve , nrdeve , nituse , nrtuse ,                            &
36
29
   itepa  ,                                                       &
37
 
   idevel , ituser , ia     ,                                     &
38
30
   rtp    ,                                                       &
39
 
   ettp   , tepa   , vagaus ,                                     &
40
 
   w1     , w2     , w3     ,                                     &
41
 
   rdevel , rtuser , ra     )
 
31
   ettp   , tepa   , vagaus )
42
32
 
43
33
!===============================================================================
44
34
! FONCTION :
55
45
!__________________.____._____.________________________________________________.
56
46
! name             !type!mode ! role                                           !
57
47
!__________________!____!_____!________________________________________________!
58
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
59
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
60
48
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
61
49
! ncel             ! i  ! <-- ! number of cells                                !
62
50
! nbpmax           ! e  ! <-- ! nombre max de particulies autorise             !
66
54
! nivep            ! e  ! <-- ! nombre info particulaires (entiers)            !
67
55
! npar1 ,npar2     ! e  ! <-- ! borne min et max des particules                !
68
56
!                  !    !     !    a initialiser                               !
69
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
70
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
71
57
! itepa            ! te ! <-- ! info particulaires (entiers)                   !
72
58
! (nbpmax,nivep    !    !     !   (cellule de la particule,...)                !
73
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
74
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
75
 
! ia(*)            ! ia ! --- ! main integer work array                        !
76
59
! rtp              ! tr ! <-- ! variables de calcul au centre des              !
77
60
! (ncelet,*)       !    !     !    cellules (instant courant ou prec)          !
78
61
! ettp             ! tr ! <-- ! tableaux des variables liees                   !
81
64
! (nbpmax,nvep)    !    !     !   (poids statistiques,...)                     !
82
65
! vagaus           ! tr ! --> ! variables aleatoires gaussiennes               !
83
66
!(nbpmax,nvgaus    !    !     !                                                !
84
 
! w1...w3(ncel)    ! tr ! --- ! tableau de travail                             !
85
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
86
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
87
 
! ra(*)            ! ra ! --- ! main real work array                           !
88
67
!__________________!____!_____!________________________________________________!
89
68
 
90
69
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
91
70
!            L (LOGIQUE)   .. ET TYPES COMPOSES (EX : TR TABLEAU REEL)
92
71
!     MODE : <-- donnee, --> resultat, <-> Donnee modifiee
93
72
!            --- tableau de travail
 
73
!===============================================================================
 
74
 
 
75
!===============================================================================
 
76
! Module files
 
77
!===============================================================================
 
78
 
 
79
use paramx
 
80
use cstnum
 
81
use numvar
 
82
use optcal
 
83
use entsor
 
84
use cstphy
 
85
use pointe
 
86
use parall
 
87
use period
 
88
use lagpar
 
89
use lagran
94
90
 
95
91
!===============================================================================
96
92
 
97
93
implicit none
98
94
 
99
 
!===============================================================================
100
 
! Common blocks
101
 
!===============================================================================
102
 
 
103
 
include "paramx.h"
104
 
include "cstnum.h"
105
 
include "numvar.h"
106
 
include "optcal.h"
107
 
include "entsor.h"
108
 
include "cstphy.h"
109
 
include "pointe.h"
110
 
include "period.h"
111
 
include "parall.h"
112
 
include "lagpar.h"
113
 
include "lagran.h"
114
 
 
115
 
!===============================================================================
116
 
 
117
95
! Arguments
118
96
 
119
 
integer          idbia0 , idbra0
120
97
integer          ncelet , ncel
121
98
integer          nbpmax , nvp    , nvp1   , nvep  , nivep
122
99
integer          npar1 , npar2
123
 
integer          nideve , nrdeve , nituse , nrtuse
124
100
integer          itepa(nbpmax,nivep)
125
 
integer          idevel(nideve), ituser(nituse)
126
 
integer          ia(*)
127
101
 
128
102
double precision rtp(ncelet,*)
129
103
double precision ettp(nbpmax,nvp) , tepa(nbpmax,nvep)
130
104
double precision vagaus(nbpmax,*)
131
 
double precision w1(ncelet) ,  w2(ncelet) ,  w3(ncelet)
132
 
double precision rdevel(nrdeve), rtuser(nrtuse)
133
 
double precision ra(*)
134
105
 
135
106
! Local variables
136
107
 
137
 
integer          idebia , idebra
138
 
integer          iel , npt , nomb , iphas
 
108
integer          iel , npt , nomb
139
109
double precision tu , d2s3
140
110
 
141
 
!===============================================================================
142
 
 
143
 
!===============================================================================
144
 
! 0.  GESTION MEMOIRE
145
 
!===============================================================================
146
 
 
147
 
idebia = idbia0
148
 
idebra = idbra0
 
111
double precision, allocatable, dimension(:) :: w1
 
112
 
 
113
!===============================================================================
149
114
 
150
115
!===============================================================================
151
116
! 1. INITIALISATION
152
117
!===============================================================================
153
118
 
154
 
iphas = ilphas
155
119
d2s3 = 2.d0 / 3.d0
156
120
 
 
121
! Allocate a work array
 
122
allocate(w1(ncelet))
 
123
 
157
124
!===============================================================================
158
125
! 2. SIMULATION DES VITESSES TURBULENTES FLUIDES INSTANTANNEES VUES
159
126
!    PAR LES PARTICULES SOLIDES LE LONG DE LEUR TRAJECTOIRE.
161
128
 
162
129
if (idistu.eq.1) then
163
130
 
164
 
  if (itytur(iphas).eq.2 .or. iturb(iphas).eq.50                  &
165
 
       .or. iturb(iphas).eq.60) then
 
131
  if (itytur.eq.2 .or. iturb.eq.50                  &
 
132
       .or. iturb.eq.60) then
166
133
    do iel = 1,ncel
167
 
      w1(iel) = rtp(iel,ik(iphas))
 
134
      w1(iel) = rtp(iel,ik)
168
135
    enddo
169
 
  else if (itytur(iphas).eq.3) then
 
136
  else if (itytur.eq.3) then
170
137
    do iel = 1,ncel
171
 
      w1(iel) = 0.5d0 * ( rtp(iel,ir11(iphas))                    &
172
 
                        + rtp(iel,ir22(iphas))                    &
173
 
                        + rtp(iel,ir33(iphas)) )
 
138
      w1(iel) = 0.5d0 * ( rtp(iel,ir11)                    &
 
139
                        + rtp(iel,ir22)                    &
 
140
                        + rtp(iel,ir33) )
174
141
    enddo
175
142
  else
176
 
    write(nfecra,9000) iilagr, idistu, iphas, iturb(iphas)
 
143
    write(nfecra,9000) iilagr, idistu, iturb
177
144
    call csexit (1)
178
145
    !==========
179
146
  endif
208
175
 
209
176
  tu = sqrt( d2s3*w1(iel) )
210
177
 
211
 
  ettp(npt,juf) = rtp(iel,iu(iphas)) + vagaus(npt,1)*tu
212
 
  ettp(npt,jvf) = rtp(iel,iv(iphas)) + vagaus(npt,2)*tu
213
 
  ettp(npt,jwf) = rtp(iel,iw(iphas)) + vagaus(npt,3)*tu
 
178
  ettp(npt,juf) = rtp(iel,iu) + vagaus(npt,1)*tu
 
179
  ettp(npt,jvf) = rtp(iel,iv) + vagaus(npt,2)*tu
 
180
  ettp(npt,jwf) = rtp(iel,iw) + vagaus(npt,3)*tu
214
181
 
215
182
enddo
216
183
 
 
184
! Free memory
 
185
deallocate(w1)
 
186
 
217
187
!--------
218
188
! FORMATS
219
189
!--------
232
202
'@   Le module Lagrangien a ete active avec IILAGR = ',I10     ,/,&
233
203
'@     et la dispersion turbulente est prise en compte        ',/,&
234
204
'@                                     avec IDISTU = ',I10     ,/,&
235
 
'@   Le modele de turbulence active pour la phase ',I6         ,/,&
 
205
'@   Le modele de turbulence                                  ',/,&
236
206
'@     correspond a ITURB  = ',I10                             ,/,&
237
207
'@   Or, les seuls traitements de la turbulence compatibles   ',/,&
238
208
'@     avec le module Lagrangien et la dispersion turbulente  ',/,&