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

« back to all changes in this revision

Viewing changes to src/lagr/laglec.f90

  • Committer: Package Import Robot
  • Author(s): Sylvestre Ledru
  • Date: 2011-11-01 17:43:32 UTC
  • mto: (6.1.7 sid)
  • mto: This revision was merged to the branch mainline in revision 11.
  • Revision ID: package-import@ubuntu.com-20111101174332-tl4vk45no0x3emc3
Tags: upstream-2.1.0
Import upstream version 2.1.0

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 laglec &
29
24
!================
30
25
 
31
 
 ( idbia0 , idbra0 ,                                              &
32
 
   ndim   , ncelet , ncel   , nfac   , nfabor ,                   &
 
26
 ( ndim   , ncelet , ncel   , nfac   , nfabor ,                   &
33
27
   nbpmax , nvp    , nvp1   , nvep   , nivep  ,                   &
34
28
   ntersl , nvlsta , nvisbr ,                                     &
35
 
   itepa  , ia     ,                                              &
 
29
   itepa  ,                                                       &
36
30
   rtpa   , propce ,                                              &
37
 
   ettp   , tepa   , statis , stativ , parbor , tslagr , ra     )
 
31
   ettp   , tepa   , statis , stativ , parbor , tslagr )
38
32
 
39
33
!===============================================================================
40
34
! FONCTION :
48
42
!    volumiques et aux frontieres, ainsi que les termes sources
49
43
!    de couplage retour.
50
44
 
51
 
!    Tous les tableaux sont initialise a zero avant d'�tre remplis
 
45
!    Tous les tableaux sont initialise a zero avant d'être remplis
52
46
!    dans le cas d'une suite (sinon ils restent a zero).
53
47
!    On realise donc ici l'initialisation des tableaux ouverts
54
48
!    dans MEMLA1, ce qui termine l'etape d'initialisation debutee
60
54
!__________________.____._____.________________________________________________.
61
55
! name             !type!mode ! role                                           !
62
56
!__________________!____!_____!________________________________________________!
63
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
64
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
65
57
! ndim             ! i  ! <-- ! spatial dimension                              !
66
58
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
67
59
! ncel             ! i  ! <-- ! number of cells                                !
77
69
! nvisbr           ! e  ! <-- ! nombre de statistiques aux frontieres          !
78
70
! itepa            ! te ! <-- ! info particulaires (entiers)                   !
79
71
! (nbpmax,nivep    !    !     !   (cellule de la particule,...)                !
80
 
! ia(*)            ! ia ! --- ! main integer work array                        !
81
72
! rtpa             ! tr ! <-- ! variables de calcul au centre des              !
82
73
! (ncelet,*)       !    !     !    cellules instant precedent                  !
83
74
! propce(ncelet, *)! ra ! <-- ! physical properties at cell centers            !
94
85
!(nfabor,nvisbr    !    !     !   aux faces de bord                            !
95
86
! tslagr           ! tr ! <-- ! terme de couplage retour du                    !
96
87
!(ncelet,ntersl    !    !     !   lagrangien sur la phase porteuse             !
97
 
! ra(*)            ! ra ! --- ! main real work array                           !
98
88
!__________________!____!_____!________________________________________________!
99
89
 
100
90
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
101
91
!            L (LOGIQUE)   .. ET TYPES COMPOSES (EX : TR TABLEAU REEL)
102
92
!     MODE : <-- donnee, --> resultat, <-> Donnee modifiee
103
93
!            --- tableau de travail
 
94
!===============================================================================
 
95
 
 
96
!===============================================================================
 
97
! Module files
 
98
!===============================================================================
 
99
 
 
100
use paramx
 
101
use cstnum
 
102
use cstphy
 
103
use numvar
 
104
use optcal
 
105
use entsor
 
106
use parall
 
107
use period
 
108
use lagpar
 
109
use lagran
 
110
use ppppar
 
111
use ppthch
 
112
use ppincl
 
113
use cpincl
 
114
use radiat
104
115
 
105
116
!===============================================================================
106
117
 
107
118
implicit none
108
119
 
109
 
!===============================================================================
110
 
! Common blocks
111
 
!===============================================================================
112
 
 
113
 
include "paramx.h"
114
 
include "cstnum.h"
115
 
include "cstphy.h"
116
 
include "numvar.h"
117
 
include "optcal.h"
118
 
include "entsor.h"
119
 
include "period.h"
120
 
include "parall.h"
121
 
include "lagpar.h"
122
 
include "lagran.h"
123
 
include "ppppar.h"
124
 
include "ppthch.h"
125
 
include "ppincl.h"
126
 
include "cpincl.h"
127
 
include "radiat.h"
128
 
 
129
 
!===============================================================================
130
 
 
131
120
! Arguments
132
121
 
133
 
integer          idbia0 , idbra0
134
122
integer          ndim   , ncelet , ncel   , nfac   , nfabor
135
123
integer          nbpmax , nvp    , nvp1   , nvep  , nivep
136
124
integer          ntersl , nvlsta , nvisbr
137
 
integer          itepa(nbpmax,nivep)  , ia(*)
 
125
integer          itepa(nbpmax,nivep)
138
126
 
139
127
double precision rtpa(ncelet,*) , propce(ncelet,*)
140
128
double precision ettp(nbpmax,nvp) , tepa(nbpmax,nvep)
142
130
double precision stativ(ncelet,nvlsta-1)
143
131
double precision tslagr(ncelet,ntersl)
144
132
double precision parbor(nfabor,nvisbr)
145
 
double precision ra(*)
146
133
 
147
134
! Local variables
148
135
 
149
136
character        rubriq*64 , car4*4, car8*8, kar8*8
150
137
character        nomnvl(nvplmx)*60 , nomtsl(nvplmx)*60
151
138
character        nomite(nvplmx)*64 , nomrte(nvplmx)*64
152
 
integer          idebia , idebra
 
139
character        ficsui*32
153
140
integer          ncelok , nfaiok , nfabok , nsomok
154
141
integer          ierror , irtyp  , itysup , nbval
155
142
integer          ilecec , nberro , ivers
156
143
integer          mvls   , ivar   , ip     , icha
157
 
integer          ifac   , iel    , iok    , iphas
 
144
integer          ifac   , iel    , iok
158
145
integer          jphyla , jtpvar , jdpvar , jmpvar
159
146
integer          jsttio , jdstnt , mstist , mvlsts
160
147
integer          mstbor , musbor , mstits , jturb, jtytur
166
153
! 0. Gestion memoire
167
154
!===============================================================================
168
155
 
169
 
idebia = idbia0
170
 
idebra = idbra0
171
156
 
172
157
!===============================================================================
173
158
! 1. Initialisations par defaut
177
162
!     tableaux lagrangiens ouverts dans la routine MEMLA1
178
163
!     (sauf ITYCEL et ICOCEL qui sont initialises dans LAGDEB),
179
164
 
180
 
iphas = ilphas
181
 
 
182
165
do ivar = 1,nvp
183
166
  do ip = 1,nbpmax
184
167
    ettp(ip,ivar) = 0.d0
244
227
 
245
228
!     (ILECEC=1:lecture)
246
229
ilecec = 1
247
 
call opnsui(ficaml,len(ficaml),ilecec,impaml,ierror)
 
230
ficsui = 'lagrangian'
 
231
call opnsui(ficsui,len(ficsui),ilecec,impaml,ierror)
248
232
!==========
249
233
if(ierror.ne.0) then
250
 
  write(nfecra,9010) ficaml, ficaml
 
234
  write(nfecra,9010) ficsui, ficsui
251
235
  call csexit (1)
252
236
endif
253
237
 
468
452
if (iphyla.eq.2) then
469
453
  NOMITE(JINCH) = 'numero_charbon'
470
454
endif
 
455
! deposition submodel
 
456
if (idepst.eq.1) then
 
457
  NOMITE(jimark) = 'indicateur_de_saut'
 
458
  NOMITE(JDIEL) = 'diel_particules'
 
459
  NOMITE(JDFAC) = 'dfac_particules'
 
460
  NOMITE(JDIFEL) = 'difel_particules'
 
461
  NOMITE(JTRAJ) = 'traj_particules'
 
462
  NOMITE(JPTDET) = 'ptdet_particules'
 
463
  NOMITE(jinjst) = 'indic_stat'
 
464
endif
471
465
 
472
466
nbval  = nbpart
473
467
irtyp  = 1
492
486
  NOMRTE(JRR0P) = 'masse_volumique_initial_charbon'
493
487
endif
494
488
 
 
489
! Deposition submodel
 
490
if (idepst.eq.1) then
 
491
   NOMRTE(jryplu) = 'yplus_particules'
 
492
   NOMRTE(jrinpf) = 'dx_particules'
 
493
endif
 
494
 
495
495
nbval  = nbpart
496
496
irtyp  = 2
497
497
 
565
565
                ippmod(ielarc).ge.0 .or.                          &
566
566
                ippmod(ieljou).ge.0      ) then
567
567
         ettp(ip,jtf) = propce(iel,ipproc(itemp)) -tkelvi
568
 
      else if ( iscsth(iscalt(iphas)).eq.1 ) then
569
 
         ettp(ip,jtf) = rtpa(iel,isca(iscalt(iphas))) -tkelvi
570
 
      else if ( iscsth(iscalt(iphas)).eq.-1 ) then
571
 
         ettp(ip,jtf) = rtpa(iel,isca(iscalt(iphas)))
572
 
      else if ( iscsth(iscalt(iphas)).eq.2 ) then
 
568
      else if ( iscsth(iscalt).eq.1 ) then
 
569
         ettp(ip,jtf) = rtpa(iel,isca(iscalt)) -tkelvi
 
570
      else if ( iscsth(iscalt).eq.-1 ) then
 
571
         ettp(ip,jtf) = rtpa(iel,isca(iscalt))
 
572
      else if ( iscsth(iscalt).eq.2 ) then
573
573
         mode = 1
574
 
         call usthht(mode, rtpa(iel,isca(iscalt(iphas))),         &
 
574
         call usthht(mode, rtpa(iel,isca(iscalt)),         &
575
575
                     ettp(ip,jtf))
576
576
      endif
577
577
    enddo
637
637
 
638
638
!     (ILECEC=1:lecture)
639
639
  ilecec = 1
640
 
  call opnsui(ficmls,len(ficmls),ilecec,impmls,ierror)
 
640
  ficsui = 'lagrangian_stats'
 
641
  call opnsui(ficsui,len(ficsui),ilecec,impmls,ierror)
641
642
  !==========
642
643
  if(ierror.ne.0) then
643
 
    write(nfecra,9010) ficmls, ficmls
 
644
    write(nfecra,9010) ficsui, ficsui
644
645
    call csexit (1)
645
646
  endif
646
647
 
1021
1022
      IF (JTYTUR.EQ.3) CAR8 = 'Rij-eps'
1022
1023
      IF (JTURB.EQ.50) CAR8 = 'v2f'
1023
1024
      IF (JTURB.EQ.60) CAR8 = 'k-omega'
1024
 
      IF (ITYTUR(IPHAS).EQ.2) KAR8 = 'k-eps'
1025
 
      IF (ITYTUR(IPHAS).EQ.3) KAR8 = 'Rij-eps'
1026
 
      IF (ITURB(IPHAS).EQ.50) KAR8 = 'v2f'
1027
 
      IF (ITURB(IPHAS).EQ.60) KAR8 = 'k-omega'
 
1025
      IF (ITYTUR.EQ.2) KAR8 = 'k-eps'
 
1026
      IF (ITYTUR.EQ.3) KAR8 = 'Rij-eps'
 
1027
      IF (ITURB.EQ.50) KAR8 = 'v2f'
 
1028
      IF (ITURB.EQ.60) KAR8 = 'k-omega'
1028
1029
      write (nfecra,9330) ficmls,                                 &
1029
1030
                          jsttio, mstits, car8,                   &
1030
1031
                          isttio, nstits, kar8
1072
1073
      NOMTSL(ITSVY) = 'terme_source_vitesseY'
1073
1074
      NOMTSL(ITSVZ) = 'terme_source_vitesseZ'
1074
1075
      NOMTSL(ITSLI) = 'terme_source_vitesse_implicite'
1075
 
      if (itytur(iphas).eq.2 .or. iturb(iphas).eq.50              &
1076
 
           .or. iturb(iphas).eq.60) then
 
1076
      if (itytur.eq.2 .or. iturb.eq.50              &
 
1077
           .or. iturb.eq.60) then
1077
1078
        NOMTSL(ITSKE) = 'terme_source_turbulence_keps'
1078
 
      else if (itytur(iphas).eq.3) then
 
1079
      else if (itytur.eq.3) then
1079
1080
        NOMTSL(ITSR11) = 'terme_source_turbulence_R11'
1080
1081
        NOMTSL(ITSR12) = 'terme_source_turbulence_R12'
1081
1082
        NOMTSL(ITSR13) = 'terme_source_turbulence_R13'