← Back to branch summary

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

« back to all changes in this revision

Viewing changes to users/ctwr/usctiv.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/ctwr/usctiv.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 usctiv &
32
26
!================
33
27
 
34
 
 ( idbia0 , idbra0 ,                                              &
35
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
36
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
37
 
   nvar   , nscal  , nphas  ,                                     &
38
 
   nideve , nrdeve , nituse , nrtuse ,                            &
39
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml , maxelt , lstelt , &
40
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
41
 
   idevel , ituser , ia     ,                                     &
42
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
43
 
   dt     , rtp    , propce , propfa , propfb , coefa  , coefb  , &
44
 
   rdevel , rtuser , ra     )
 
28
 ( nvar   , nscal  ,                                              &
 
29
   dt     , rtp    , propce , propfa , propfb , coefa  , coefb  )
45
30
 
46
31
!===============================================================================
47
32
! FONCTION :
69
54
!     PROPCE (prop au centre), PROPFA (aux faces internes),
70
55
!     PROPFB (prop aux faces de bord)
71
56
!     Ainsi,
72
 
!      PROPCE(IEL,IPPROC(IROM  (IPHAS))) designe ROM   (IEL ,IPHAS)
73
 
!      PROPCE(IEL,IPPROC(IVISCL(IPHAS))) designe VISCL (IEL ,IPHAS)
74
 
!      PROPCE(IEL,IPPROC(ICP   (IPHAS))) designe CP    (IEL ,IPHAS)
 
57
!      PROPCE(IEL,IPPROC(IROM  )) designe ROM   (IEL)
 
58
!      PROPCE(IEL,IPPROC(IVISCL)) designe VISCL (IEL)
 
59
!      PROPCE(IEL,IPPROC(ICP   )) designe CP    (IEL)
75
60
!      PROPCE(IEL,IPPROC(IVISLS(ISCAL))) designe VISLS (IEL ,ISCAL)
76
61
 
77
62
!      PROPFA(IFAC,IPPROF(IFLUMA(IVAR ))) designe FLUMAS(IFAC,IVAR)
78
63
 
79
 
!      PROPFB(IFAC,IPPROB(IROM  (IPHAS))) designe ROMB  (IFAC,IPHAS)
 
64
!      PROPFB(IFAC,IPPROB(IROM  )) designe ROMB  (IFAC)
80
65
!      PROPFB(IFAC,IPPROB(IFLUMA(IVAR ))) designe FLUMAB(IFAC,IVAR)
81
66
 
82
67
 
100
85
!__________________.____._____.________________________________________________.
101
86
! name             !type!mode ! role                                           !
102
87
!__________________!____!_____!________________________________________________!
103
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
104
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
105
 
! ndim             ! i  ! <-- ! spatial dimension                              !
106
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
107
 
! ncel             ! i  ! <-- ! number of cells                                !
108
 
! nfac             ! i  ! <-- ! number of interior faces                       !
109
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
110
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
111
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
112
 
! nnod             ! i  ! <-- ! number of vertices                             !
113
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
114
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
115
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
116
88
! nvar             ! i  ! <-- ! total number of variables                      !
117
89
! nscal            ! i  ! <-- ! total number of scalars                        !
118
 
! nphas            ! i  ! <-- ! number of phases                               !
119
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
120
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
121
 
! ifacel(2, nfac)  ! ia ! <-- ! interior faces -> cells connectivity           !
122
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
123
 
! ifmfbr(nfabor)   ! ia ! <-- ! boundary face family numbers                   !
124
 
! ifmcel(ncelet)   ! ia ! <-- ! cell family numbers                            !
125
 
! iprfml           ! ia ! <-- ! property numbers per family                    !
126
 
!  (nfml, nprfml)  !    !     !                                                !
127
 
! maxelt           ! i  ! <-- ! max number of cells and faces (int/boundary)   !
128
 
! lstelt(maxelt)   ! ia ! --- ! work array                                     !
129
 
! ipnfac(nfac+1)   ! ia ! <-- ! interior faces -> vertices index (optional)    !
130
 
! nodfac(lndfac)   ! ia ! <-- ! interior faces -> vertices list (optional)     !
131
 
! ipnfbr(nfabor+1) ! ia ! <-- ! boundary faces -> vertices index (optional)    !
132
 
! nodfbr(lndfbr)   ! ia ! <-- ! boundary faces -> vertices list (optional)     !
133
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
134
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
135
 
! ia(*)            ! ia ! --- ! main integer work array                        !
136
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
137
 
!  (ndim, ncelet)  !    !     !                                                !
138
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
139
 
!  (ndim, nfac)    !    !     !                                                !
140
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
141
 
!  (ndim, nfabor)  !    !     !                                                !
142
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
143
 
!  (ndim, nfac)    !    !     !                                                !
144
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
145
 
!  (ndim, nfabor)  !    !     !                                                !
146
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !
147
 
!  (ndim, nnod)    !    !     !                                                !
148
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !
149
90
! dt(ncelet)       ! tr ! <-- ! valeur du pas de temps                         !
150
91
! rtp              ! tr ! <-- ! variables de calcul au centre des              !
151
92
! (ncelet,*)       !    !     !    cellules                                    !
154
95
! propfb(nfabor, *)! ra ! <-- ! physical properties at boundary face centers   !
155
96
! coefa coefb      ! tr ! <-- ! conditions aux limites aux                     !
156
97
!  (nfabor,*)      !    !     !    faces de bord                               !
157
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
158
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
159
 
! ra(*)            ! ra ! --- ! main real work array                           !
160
98
!__________________!____!_____!________________________________________________!
161
99
 
162
100
!     Type: i (integer), r (real), s (string), a (array), l (logical),
164
102
!     mode: <-- input, --> output, <-> modifies data, --- work array
165
103
!===============================================================================
166
104
 
 
105
!===============================================================================
 
106
! Module files
 
107
!===============================================================================
 
108
 
 
109
use paramx
 
110
use pointe
 
111
use numvar
 
112
use optcal
 
113
use cstphy
 
114
use entsor
 
115
use parall
 
116
use period
 
117
use ppppar
 
118
use ppthch
 
119
use ppincl
 
120
use ctincl
 
121
use mesh
 
122
 
 
123
!===============================================================================
 
124
 
167
125
implicit none
168
126
 
169
 
!===============================================================================
170
 
! Common blocks
171
 
!===============================================================================
172
 
 
173
 
include "paramx.h"
174
 
include "pointe.h"
175
 
include "numvar.h"
176
 
include "optcal.h"
177
 
include "cstphy.h"
178
 
include "entsor.h"
179
 
include "parall.h"
180
 
include "period.h"
181
 
include "ppppar.h"
182
 
include "ppthch.h"
183
 
include "ppincl.h"
184
 
include "ctincl.h"
185
 
 
186
 
!===============================================================================
187
 
 
188
 
integer          idbia0 , idbra0
189
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
190
 
integer          nfml   , nprfml
191
 
integer          nnod   , lndfac , lndfbr , ncelbr
192
 
integer          nvar   , nscal  , nphas
193
 
integer          nideve , nrdeve , nituse , nrtuse
194
 
 
195
 
integer          ifacel(2,nfac) , ifabor(nfabor)
196
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
197
 
integer          iprfml(nfml,nprfml), maxelt, lstelt(maxelt)
198
 
integer          ipnfac(nfac+1), nodfac(lndfac)
199
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr)
200
 
integer          idevel(nideve), ituser(nituse), ia(*)
201
 
 
202
 
double precision xyzcen(ndim,ncelet)
203
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
204
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
205
 
double precision xyznod(ndim,nnod), volume(ncelet)
 
127
integer          nvar   , nscal
 
128
 
206
129
double precision dt(ncelet), rtp(ncelet,*), propce(ncelet,*)
207
130
double precision propfa(nfac,*), propfb(nfabor,*)
208
131
double precision coefa(nfabor,*), coefb(nfabor,*)
209
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
210
132
 
211
133
! Local variables
212
134
 
213
 
integer          idebia, idebra
214
 
integer          iel, iutile, iphas
 
135
integer          iel, iutile
215
136
integer          ilelt, nlelt
216
137
 
217
138
double precision d2s3
218
139
 
 
140
integer, allocatable, dimension(:) :: lstelt
 
141
 
219
142
!===============================================================================
220
143
 
221
144
! TEST_TO_REMOVE_FOR_USE_OF_SUBROUTINE_START
235
158
! 1.  INITIALISATION VARIABLES LOCALES
236
159
!===============================================================================
237
160
 
238
 
idebia = idbia0
239
 
idebra = idbra0
 
161
! Allocate a temporary array for cells selection
 
162
allocate(lstelt(ncel))
 
163
 
240
164
 
241
165
d2s3 = 2.d0/3.d0
242
166
 
245
169
!      UNIQUEMENT SI ON NE FAIT PAS UNE SUITE
246
170
!===============================================================================
247
171
 
248
 
iphas = 1
249
 
 
250
172
if (isuite.eq.0) then
251
173
 
252
174
!   --- Initialisation de la temperature de l'air a 11 deg Celsius
272
194
 
273
195
    iel = lstelt(ilelt)
274
196
 
275
 
    rtp(iel,iu(iphas)) = -0.5d0
 
197
    rtp(iel,iu) = -0.5d0
276
198
 
277
199
    rtp(iel,isca(itemp4)) = 20.d0
278
200
    rtp(iel,isca(ihumid)) = 0.012d0
289
211
! FIN
290
212
!----
291
213
 
 
214
! Deallocate the temporary array
 
215
deallocate(lstelt)
 
216
 
292
217
return
293
218
end subroutine