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

« back to all changes in this revision

Viewing changes to src/ctwr/cttssc.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 cttssc &
29
24
!================
30
25
 
31
 
 ( idbia0 , idbra0 ,                                              &
32
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
33
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
34
 
   nvar   , nscal  , nphas  , ncepdp , nckpdp , ncesmp ,          &
35
 
   nideve , nrdeve , nituse , nrtuse , iscal  ,                   &
36
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml , itypfb ,          &
37
 
   ipnfac , nodfac , ipnfbr , nodfbr , icepdc , icetsm , itypsm , &
38
 
   izfppp , idevel , ituser , ia     ,                            &
39
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
26
 ( nvar   , nscal  , ncepdp , ncesmp ,                            &
 
27
   iscal  ,                                                       &
 
28
   itypfb ,                                                       &
 
29
   icepdc , icetsm , itypsm ,                                     &
 
30
   izfppp ,                                                       &
40
31
   dt     , rtpa   , rtp    , propce , propfa , propfb ,          &
41
32
   coefa  , coefb  , ckupdc , smacel ,                            &
42
 
   smbrs  , rovsdt ,                                              &
43
 
   viscf  , viscb  , xam    ,                                     &
44
 
   w1     , w2     , w3     , w4     , w5     ,                   &
45
 
   w6     , w7     , w8     , w9     , w10    , w11    ,          &
46
 
   rdevel , rtuser , ra     )
 
33
   smbrs  , rovsdt )
47
34
 
48
35
!===============================================================================
49
36
! FONCTION :
55
42
!__________________.____._____.________________________________________________.
56
43
! name             !type!mode ! role                                           !
57
44
!__________________!____!_____!________________________________________________!
58
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
59
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
60
 
! ndim             ! i  ! <-- ! spatial dimension                              !
61
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
62
 
! ncel             ! i  ! <-- ! number of cells                                !
63
 
! nfac             ! i  ! <-- ! number of interior faces                       !
64
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
65
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
66
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
67
 
! nnod             ! i  ! <-- ! number of vertices                             !
68
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
69
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
70
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
71
45
! nvar             ! i  ! <-- ! total number of variables                      !
72
46
! nscal            ! i  ! <-- ! total number of scalars                        !
73
 
! nphas            ! i  ! <-- ! number of phases                               !
74
47
! ncepdp           ! i  ! <-- ! number of cells with head loss                 !
75
 
! nckpdp           ! e  ! <-- ! nbr de coef du tenseur de pdc (3 ou 6          !
76
48
! ncesmp           ! i  ! <-- ! number of cells with mass source term          !
77
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
78
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
79
49
! iscal            ! i  ! <-- ! scalar number                                  !
80
 
! ifacel(2, nfac)  ! ia ! <-- ! interior faces -> cells connectivity           !
81
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
82
 
! ifmfbr(nfabor)   ! ia ! <-- ! boundary face family numbers                   !
83
 
! ifmcel(ncelet)   ! ia ! <-- ! cell family numbers                            !
84
 
! iprfml           ! te ! <-- ! proprietes d'une famille                       !
85
50
! itypfb(nfabor    ! te ! --> ! type des faces de bord                         !
86
 
! nfml  ,nprfml    !    !     !                                                !
87
 
! ipnfac(nfac+1)   ! ia ! <-- ! interior faces -> vertices index (optional)    !
88
 
! nodfac(lndfac)   ! ia ! <-- ! interior faces -> vertices list (optional)     !
89
 
! ipnfbr(nfabor+1) ! ia ! <-- ! boundary faces -> vertices index (optional)    !
90
 
! nodfbr(lndfbr)   ! ia ! <-- ! boundary faces -> vertices list (optional)     !
91
51
! icepdc(ncelet    ! te ! <-- ! numero des ncepdp cellules avec pdc            !
92
52
! icetsm(ncesmp    ! te ! <-- ! numero des cellules a source de masse          !
93
53
! itypsm           ! te ! <-- ! type de source de masse pour les               !
94
54
! (ncesmp,nvar)    !    !     !  variables (cf. ustsma)                        !
95
55
! izfppp           ! te ! --> ! numero de zone de la face de bord              !
96
56
! (nfabor)         !    !     !  pour le module phys. part.                    !
97
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
98
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
99
 
! ia(*)            ! ia ! --- ! main integer work array                        !
100
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
101
 
!  (ndim, ncelet)  !    !     !                                                !
102
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
103
 
!  (ndim, nfac)    !    !     !                                                !
104
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
105
 
!  (ndim, nfabor)  !    !     !                                                !
106
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
107
 
!  (ndim, nfac)    !    !     !                                                !
108
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
109
 
!  (ndim, nfabor)  !    !     !                                                !
110
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !
111
 
!  (ndim, nnod)    !    !     !                                                !
112
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !
113
57
! dt(ncelet)       ! ra ! <-- ! time step (per cell)                           !
114
58
! rtp, rtpa        ! ra ! <-- ! calculated variables at cell centers           !
115
59
!  (ncelet, *)     !    !     !  (at current and previous time steps)          !
118
62
! propfb(nfabor, *)! ra ! <-- ! physical properties at boundary face centers   !
119
63
! coefa, coefb     ! ra ! <-- ! boundary conditions                            !
120
64
!  (nfabor, *)     !    !     !                                                !
121
 
! ckupdc(ncepdp    ! tr ! <-- ! tableau de travail pour pdc                    !
122
 
!     , nckpdp)    !    !     !                                                !
 
65
! ckupdc(ncepdp,6) ! tr ! <-- ! tableau de travail pour pdc                    !
123
66
! smacel           ! tr ! <-- ! valeur des variables associee a la             !
124
67
! (ncesmp,*   )    !    !     !  source de masse                               !
125
68
!                  !    !     !  pour ivar=ipr, smacel=flux de masse           !
126
69
! smbrs(ncelet)    ! tr ! --> ! second membre explicite                        !
127
70
! rovsdt(ncelet    ! tr ! --> ! partie diagonale implicite                     !
128
 
! viscf(nfac)      ! tr ! --- ! tableau de travail    faces internes           !
129
 
! viscb(nfabor     ! tr ! --- ! tableau de travail    faces de bord            !
130
 
! xam(nfac,2)      ! tr ! --- ! tableau de travail    faces de bord            !
131
 
! w1..11(ncelet    ! tr ! --- ! tableau de travail    cellules                 !
132
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
133
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
134
 
! ra(*)            ! ra ! --- ! main real work array                           !
135
71
!__________________!____!_____!________________________________________________!
136
72
 
137
73
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
138
74
!            L (LOGIQUE)   .. ET TYPES COMPOSES (EX : TR TABLEAU REEL)
139
75
!     MODE : <-- donnee, --> resultat, <-> Donnee modifiee
140
76
!            --- tableau de travail
141
 
!-------------------------------------------------------------------------------
 
77
!===============================================================================
 
78
 
 
79
!===============================================================================
 
80
! Module files
 
81
!===============================================================================
 
82
 
 
83
use paramx
 
84
use numvar
 
85
use entsor
 
86
use optcal
 
87
use cstphy
 
88
use cstnum
 
89
use period
 
90
use ppppar
 
91
use ppthch
 
92
use ppincl
 
93
use ctincl
 
94
use mesh
 
95
 
142
96
!===============================================================================
143
97
 
144
98
implicit none
145
99
 
146
 
!===============================================================================
147
 
! Common blocks
148
 
!===============================================================================
149
 
 
150
 
include "paramx.h"
151
 
include "numvar.h"
152
 
include "entsor.h"
153
 
include "optcal.h"
154
 
include "cstphy.h"
155
 
include "cstnum.h"
156
 
include "parall.h"
157
 
include "period.h"
158
 
include "ppppar.h"
159
 
include "ppthch.h"
160
 
include "ppincl.h"
161
 
include "ctincl.h"
162
 
 
163
 
!===============================================================================
164
 
 
165
100
! Arguments
166
101
 
167
 
integer          idbia0 , idbra0
168
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
169
 
integer          nfml   , nprfml
170
 
integer          nnod   , lndfac , lndfbr , ncelbr
171
 
integer          nvar   , nscal  , nphas
172
 
integer          ncepdp , nckpdp , ncesmp
173
 
integer          nideve , nrdeve , nituse , nrtuse
 
102
integer          nvar   , nscal
 
103
integer          ncepdp , ncesmp
174
104
integer          iscal
175
105
 
176
 
integer          ifacel(2,nfac) , ifabor(nfabor)
177
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
178
 
integer          iprfml(nfml,nprfml) , itypfb(nfabor,nphas)
179
 
integer          ipnfac(nfac+1), nodfac(lndfac)
180
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr)
 
106
integer          itypfb(nfabor)
181
107
integer          icepdc(ncepdp)
182
108
integer          icetsm(ncesmp), itypsm(ncesmp,nvar)
183
109
integer          izfppp(nfabor)
184
 
integer          idevel(nideve)
185
 
integer          ituser(nituse), ia(*)
186
110
 
187
 
double precision xyzcen(ndim,ncelet)
188
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
189
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
190
 
double precision xyznod(ndim,nnod), volume(ncelet)
191
111
double precision dt(ncelet), rtp(ncelet,*), rtpa(ncelet,*)
192
112
double precision propce(ncelet,*)
193
113
double precision propfa(nfac,*), propfb(nfabor,*)
194
114
double precision coefa(nfabor,*), coefb(nfabor,*)
195
 
double precision ckupdc(ncepdp,nckpdp), smacel(ncesmp,nvar)
 
115
double precision ckupdc(ncepdp,6), smacel(ncesmp,nvar)
196
116
double precision smbrs(ncelet), rovsdt(ncelet)
197
 
double precision viscf(nfac), viscb(nfabor)
198
 
double precision xam(nfac,2)
199
 
double precision w1(ncelet), w2(ncelet), w3(ncelet)
200
 
double precision w4(ncelet), w5(ncelet), w6(ncelet)
201
 
double precision w7(ncelet), w8(ncelet), w9(ncelet)
202
 
double precision w10(ncelet), w11(ncelet)
203
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
204
117
 
205
118
! Local variables
206
119
 
207
120
character*80     chaine
208
 
integer          idebia, idebra
209
121
integer          ivar , iel
210
122
integer          ipcdc1, ipcdc2, ipcdc3
211
123
integer          ipcefj
216
128
! 1. INITIALISATION
217
129
!===============================================================================
218
130
 
219
 
idebia = idbia0
220
 
idebra = idbra0
221
131
 
222
132
! --- Numero du scalaire a traiter : ISCAL
223
133