← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/lagr/lages1.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/lagr/lages1.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 lages1 &
29
24
!================
30
25
 
31
 
 ( idbia0 , idbra0 ,                                              &
32
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   ,          &
33
 
   nprfml , nnod   , lndfac , lndfbr , ncelbr ,                   &
34
 
   nvar   , nscal  , nphas  ,                                     &
 
26
 ( nvar   , nscal  ,                                              &
35
27
   nbpmax , nvp    , nvp1   , nvep   , nivep  ,                   &
36
28
   ntersl , nvlsta , nvisbr ,                                     &
37
 
   nideve , nrdeve , nituse , nrtuse ,                            &
38
 
   itepa  , idevel , ituser , ia     ,                            &
39
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
29
   itepa  ,                                                       &
40
30
   dt     , rtpa   , propce , propfa , propfb ,                   &
41
31
   ettp   , ettpa  , tepa   , statis ,                            &
42
32
   taup   , tlag   , piil   ,                                     &
43
33
   bx     , vagaus , gradpr , gradvf , romp   ,                   &
44
 
   brgaus , terbru , fextla ,                                     &
45
 
   rdevel , rtuser , ra    )
 
34
   brgaus , terbru , fextla )
46
35
 
47
36
!===============================================================================
48
37
! FONCTION :
58
47
!__________________.____._____.________________________________________________.
59
48
! name             !type!mode ! role                                           !
60
49
!__________________!____!_____!________________________________________________!
61
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
62
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
63
 
! ndim             ! i  ! <-- ! spatial dimension                              !
64
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
65
 
! ncel             ! i  ! <-- ! number of cells                                !
66
 
! nfac             ! i  ! <-- ! number of interior faces                       !
67
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
68
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
69
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
70
 
! nnod             ! i  ! <-- ! number of vertices                             !
71
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
72
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
73
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
74
50
! nvar             ! i  ! <-- ! total number of variables                      !
75
51
! nscal            ! i  ! <-- ! total number of scalars                        !
76
 
! nphas            ! i  ! <-- ! number of phases                               !
77
52
! nbpmax           ! e  ! <-- ! nombre max de particulies autorise             !
78
53
! nvp              ! e  ! <-- ! nombre de variables particulaires              !
79
54
! nvp1             ! e  ! <-- ! nvp sans position, vfluide, vpart              !
82
57
! ntersl           ! e  ! <-- ! nbr termes sources de couplage retour          !
83
58
! nvlsta           ! e  ! <-- ! nombre de var statistiques lagrangien          !
84
59
! nvisbr           ! e  ! <-- ! nombre de statistiques aux frontieres          !
85
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
86
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
87
60
! itepa            ! te ! <-- ! info particulaires (entiers)                   !
88
61
! (nbpmax,nivep    !    !     !   (cellule de la particule,...)                !
89
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
90
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
91
 
! ia(*)            ! ia ! --- ! main integer work array                        !
92
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
93
 
!  (ndim, ncelet)  !    !     !                                                !
94
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
95
 
!  (ndim, nfac)    !    !     !                                                !
96
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
97
 
!  (ndim, nfabor)  !    !     !                                                !
98
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
99
 
!  (ndim, nfac)    !    !     !                                                !
100
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
101
 
!  (ndim, nfabor)  !    !     !                                                !
102
 
! xyznod           ! tr ! <-- ! coordonnes des noeuds                          !
103
 
! (ndim,nnod)      !    !     !                                                !
104
 
! volume(ncelet    ! tr ! <-- ! volume d'un des ncelet elements                !
105
62
! dt(ncelet)       ! ra ! <-- ! time step (per cell)                           !
106
63
! rtpa             ! tr ! <-- ! variables de calcul au centre des              !
107
64
! (ncelet,*)       !    !     !    cellules (pas de temps precedent)           !
127
84
! romp             ! tr ! <-- ! masse volumique des particules                 !
128
85
! fextla           ! tr ! <-- ! champ de forces exterieur                      !
129
86
!(ncelet,3)        !    !     !    utilisateur (m/s2)                          !
130
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
131
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
132
 
! ra(*)            ! ra ! --- ! main real work array                           !
133
87
!__________________!____!_____!________________________________________________!
134
88
 
135
89
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
136
90
!            L (LOGIQUE)   .. ET TYPES COMPOSES (EX : TR TABLEAU REEL)
137
91
!     MODE : <-- donnee, --> resultat, <-> Donnee modifiee
138
92
!            --- tableau de travail
 
93
!===============================================================================
 
94
 
 
95
!===============================================================================
 
96
! Module files
 
97
!===============================================================================
 
98
 
 
99
use paramx
 
100
use numvar
 
101
use cstphy
 
102
use cstnum
 
103
use optcal
 
104
use entsor
 
105
use lagpar
 
106
use lagran
 
107
use ppppar
 
108
use ppthch
 
109
use ppincl
 
110
use mesh
139
111
 
140
112
!===============================================================================
141
113
 
142
114
implicit none
143
115
 
144
 
!===============================================================================
145
 
! Common blocks
146
 
!===============================================================================
147
 
 
148
 
include "paramx.h"
149
 
include "numvar.h"
150
 
include "cstphy.h"
151
 
include "cstnum.h"
152
 
include "optcal.h"
153
 
include "entsor.h"
154
 
include "lagpar.h"
155
 
include "lagran.h"
156
 
include "ppppar.h"
157
 
include "ppthch.h"
158
 
include "ppincl.h"
159
 
 
160
 
!===============================================================================
161
 
 
162
116
! Arguments
163
117
 
164
 
integer          idbia0 , idbra0
165
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
166
 
integer          nfml   , nprfml
167
 
integer          nnod   ,lndfac , lndfbr , ncelbr
168
 
integer          nvar   , nscal  , nphas
 
118
integer          nvar   , nscal
169
119
integer          nbpmax , nvp    , nvp1   , nvep  , nivep
170
120
integer          ntersl , nvlsta , nvisbr
171
 
integer          nideve , nrdeve , nituse , nrtuse
 
121
 
172
122
integer          itepa(nbpmax,nivep)
173
 
integer          idevel(nideve), ituser(nituse)
174
 
integer          ia(*)
175
123
 
176
 
double precision xyzcen(ndim,ncelet)
177
 
double precision surfac(ndim,nfac) , surfbo(ndim,nfabor)
178
 
double precision cdgfac(ndim,nfac) , cdgfbo(ndim,nfabor)
179
 
double precision xyznod(ndim,nnod) , volume(ncelet)
180
124
double precision dt(ncelet) , rtpa(ncelet,*)
181
125
double precision propce(ncelet,*)
182
126
double precision propfa(nfac,*) , propfb(nfabor,*)
189
133
double precision gradpr(ncelet,3) , gradvf(ncelet,9)
190
134
double precision romp(nbpmax)
191
135
double precision fextla(nbpmax,3)
192
 
double precision rdevel(nrdeve), rtuser(nrtuse)
193
 
double precision ra(*)
194
136
 
195
137
! Local variables
196
138
 
197
 
integer          idebia , idebra
198
 
integer          iel , ip , id , i0 , iromf , iphas , mode
 
139
integer          iel , ip , id , i0 , iromf , mode
199
140
 
200
141
double precision aa , bb , cc , dd , ee
201
142
double precision aux1 , aux2 ,aux3 , aux4 , aux5 , aux6
218
159
! 0.  GESTION MEMOIRE
219
160
!===============================================================================
220
161
 
221
 
idebia = idbia0
222
 
idebra = idbra0
223
162
 
224
163
!===============================================================================
225
164
! 1. INITIALISATIONS
226
165
!===============================================================================
227
166
 
228
 
iphas = ilphas
 
167
! Initialize variables to avoid compiler warnings
 
168
 
 
169
vitf = 0.d0
229
170
 
230
171
grav(1) = gx
231
172
grav(2) = gy
236
177
if ( ippmod(icp3pl).ge.0 .or. ippmod(icfuel).ge.0 ) then
237
178
  iromf = ipproc(irom1)
238
179
else
239
 
  iromf = ipproc(irom(iphas))
 
180
  iromf = ipproc(irom)
240
181
endif
241
182
 
242
183
!===============================================================================
255
196
 
256
197
      rom = propce(iel,iromf)
257
198
 
258
 
      if (id.eq.1) vitf = rtpa(iel,iu(iphas))
259
 
      if (id.eq.2) vitf = rtpa(iel,iv(iphas))
260
 
      if (id.eq.3) vitf = rtpa(iel,iw(iphas))
 
199
      if (id.eq.1) vitf = rtpa(iel,iu)
 
200
      if (id.eq.2) vitf = rtpa(iel,iv)
 
201
      if (id.eq.3) vitf = rtpa(iel,iw)
261
202
 
262
203
!---> (2.1) Calcul preliminaires :
263
204
!     ----------------------------
409
350
 
410
351
          tempf = propce(iel,ipproc(itemp))
411
352
 
412
 
        else if ( iscsth(iscalt(iphas)).eq.-1 ) then
413
 
          tempf = rtpa(iel,isca(iscalt(iphas)))
414
 
 
415
 
        else if ( iscsth(iscalt(iphas)).eq.1 ) then
416
 
          tempf = rtpa(iel,isca(iscalt(iphas)))
417
 
 
418
 
        else if ( iscsth(iscalt(iphas)).eq.2 ) then
 
353
        else if ( iscsth(iscalt).eq.-1 ) then
 
354
          tempf = rtpa(iel,isca(iscalt))
 
355
 
 
356
        else if ( iscsth(iscalt).eq.1 ) then
 
357
          tempf = rtpa(iel,isca(iscalt))
 
358
 
 
359
        else if ( iscsth(iscalt).eq.2 ) then
419
360
          mode = 1
420
 
          call usthht(mode,rtpa(iel,isca(iscalt(iphas))),tempf)
 
361
          call usthht(mode,rtpa(iel,isca(iscalt)),tempf)
421
362
          !==========
422
363
          tempf = tempf+tkelvi
423
364
        else
424
 
          tempf = t0(iphas)
 
365
          tempf = t0
425
366
        endif
426
367
 
427
368
        ddbr  = sqrt( 2.d0*kboltz*tempf                           &