← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/base/cou1do.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/base/cou1do.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 cou1do &
29
24
!================
30
25
 
31
 
 ( idbia0 , idbra0 ,                                              &
32
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
33
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
34
 
   nvar   , nscal  , nphas  , ncp    , nfpt1d ,                   &
35
 
   nideve , nrdeve , nituse , nrtuse ,                            &
36
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml,                    &
37
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
 
26
 ( nvar   , nscal  , ncp    , nfpt1d ,                            &
38
27
   ientha , ifpt1d , iclt1d ,                                     &
39
 
   idevel , ituser , ia     ,                                     &
40
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo ,                   &
41
 
   xyznod , volume ,                                              &
42
28
   tppt1d , tept1d , hept1d , fept1d ,                            &
43
29
   xlmbt1 , rcpt1d , dtpt1d , dt     , rtpa   ,                   &
44
30
   propce , propfa , propfb ,                                     &
45
31
   coefa  , coefb  ,                                              &
46
 
   cpcst  , cp     , hbord  , tbord  ,                            &
47
 
   rdevel , rtuser , ra     )
 
32
   cpcst  , cp     , hbord  , tbord  )
48
33
 
49
34
!===============================================================================
50
35
! FONCTION :
57
42
!__________________.____._____.________________________________________________.
58
43
! name             !type!mode ! role                                           !
59
44
!__________________!____!_____!________________________________________________!
60
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
61
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
62
45
! nfabor           ! i  ! <-- ! number of boundary faces                       !
63
46
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
64
47
! ncp              ! e  ! <-- ! dimension de cp (ncelet ou 1)                  !
65
48
! nfabor           ! i  ! <-- ! number of boundary faces                       !
66
49
! nvar             ! i  ! <-- ! total number of variables                      !
67
50
! nscal            ! i  ! <-- ! total number of scalars                        !
68
 
! nphas            ! i  ! <-- ! number of phases                               !
69
51
! nfpt1d           ! e  ! <-- ! nombre de faces avec module therm 1d           !
70
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
71
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
72
52
! ientha           ! e  ! <-- ! 1 si tparoi est une enthalpie                  !
73
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
74
53
! ifpt1d           ! te ! <-- ! numero de la face en traitement                !
75
54
!                  !    !     ! thermique en paroi                             !
76
55
! iclt1d           ! te ! <-- ! type de condition limite                       !
77
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
78
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
79
 
! ia(*)            ! ia ! --- ! main integer work array                        !
80
56
! cpcst            ! r  ! <-- ! chaleur specifique si constante                !
81
57
! cp(ncp)          ! tr ! <-- ! chaleur specifique si variable                 !
82
58
! hbord            ! tr ! <-- ! coefficients d'echange aux bords               !
90
66
! xlmbt1           ! tr ! <-- ! diffusivite thermique                          !
91
67
! rcpt1d           ! tr ! <-- ! rocp                                           !
92
68
! dtpt1d           ! tr ! <-- ! pas de temps                                   !
93
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
94
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
95
 
! ra(*)            ! ra ! --- ! main real work array                           !
96
69
!__________________!____!_____!________________________________________________!
97
70
 
98
71
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
101
74
!            --- tableau de travail
102
75
!===============================================================================
103
76
 
 
77
!===============================================================================
 
78
! Module files
 
79
!===============================================================================
 
80
 
 
81
use paramx
 
82
use numvar
 
83
use entsor
 
84
use optcal
 
85
use cstphy
 
86
use cstnum
 
87
use parall
 
88
use period
 
89
use pointe, only: izft1d
 
90
use mesh
 
91
 
 
92
!===============================================================================
 
93
 
104
94
implicit none
105
95
 
106
 
!===============================================================================
107
 
! Common blocks
108
 
!===============================================================================
109
 
 
110
 
include "paramx.h"
111
 
include "numvar.h"
112
 
include "entsor.h"
113
 
include "optcal.h"
114
 
include "cstphy.h"
115
 
include "cstnum.h"
116
 
include "parall.h"
117
 
include "period.h"
118
 
 
119
 
!===============================================================================
120
 
 
121
96
! Arguments
122
 
integer          idbia0 , idbra0
123
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
124
97
integer          nfpt1d
125
 
integer          nfml   , nprfml
126
 
integer          nnod   , lndfac , lndfbr , ncelbr
127
 
integer          nvar   , nscal  , nphas  , ncp
128
 
integer          nideve , nrdeve , nituse , nrtuse
 
98
integer          nvar   , nscal  , ncp
129
99
 
130
 
integer          ifacel(2,nfac) , ifabor(nfabor)
131
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
132
 
integer          iprfml(nfml,nprfml)
133
 
integer          ipnfac(nfac+1), nodfac(lndfac)
134
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr)
135
100
integer          ifpt1d(nfpt1d), iclt1d(nfpt1d)
136
101
integer          ientha
137
 
integer          idevel(nideve), ituser(nituse), ia(*)
138
102
 
139
 
double precision xyzcen(ndim,ncelet)
140
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
141
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
142
 
double precision xyznod(ndim,nnod), volume(ncelet)
143
103
double precision dt(ncelet), rtpa(ncelet,*)
144
104
double precision propce(ncelet,*)
145
105
double precision propfa(nfac,*), propfb(nfabor,*)
149
109
double precision tppt1d(nfpt1d)
150
110
double precision tept1d(nfpt1d), hept1d(nfpt1d), fept1d(nfpt1d)
151
111
double precision xlmbt1(nfpt1d), rcpt1d(nfpt1d), dtpt1d(nfpt1d)
152
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
153
112
 
154
113
!     VARIABLES LOCALES
155
114
 
156
 
integer          idebia, idebra, mode
157
 
integer          iphas  , iappel
 
115
integer          mode
 
116
integer          iappel
158
117
integer          ifac, iel , ii
159
 
integer          maxelt, ils, idbia1
 
118
 
 
119
integer          ivoid(1)
 
120
 
160
121
double precision enthal, temper
161
122
 
 
123
double precision rvoid(1)
 
124
 
162
125
!===============================================================================
163
126
 
164
 
idebia = idbia0
165
 
idebra = idbra0
166
127
 
167
128
!     SI ENTHALPIE, ON TRANSFORME EN TEMPERATURE
168
129
!     Il est necessaire de transmettre a SYRTHES des Temperatures
204
165
endif
205
166
 
206
167
!     Mise a jour des conditions aux limites externes du module 1D
207
 
iphas = 1
208
168
iappel = 3
209
169
 
210
 
maxelt = max(ncelet,nfac,nfabor)
211
 
ils    = idebia
212
 
idbia1 = ils + maxelt
213
 
CALL IASIZE('COU1DO',IDBIA1)
214
 
 
215
 
call  uspt1d                                                      &
216
 
!     ============
217
 
 ( idbia1 , idebra ,                                              &
218
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
219
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
220
 
   nvar   , nscal  , nphas  , nfpt1d , iphas  , iappel ,          &
221
 
   nideve , nrdeve , nituse , nrtuse ,                            &
222
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml , maxelt , ia(ils), &
223
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
224
 
   ifpt1d , ia(idebia), iclt1d ,                                  &
225
 
   idevel , ituser , ia     ,                                     &
226
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo ,                   &
227
 
   xyznod , volume ,                                              &
228
 
   tppt1d , ra(idebra), ra(idebra),                               &
 
170
call  uspt1d &
 
171
!===========
 
172
 ( nvar   , nscal  , nfpt1d , iappel ,                            &
 
173
   ifpt1d , izft1d , ivoid  , iclt1d ,                            &
 
174
   tppt1d , rvoid  , rvoid  ,                                     &
229
175
   tept1d , hept1d , fept1d ,                                     &
230
176
   xlmbt1 , rcpt1d , dtpt1d ,                                     &
231
177
   dt     , rtpa   ,                                              &
232
178
   propce , propfa , propfb ,                                     &
233
 
   coefa  , coefb  ,                                              &
234
 
   rdevel , rtuser , ra     )
 
179
   coefa  , coefb  )
235
180
 
236
181
iappel = 3
237
 
call vert1d                                                       &
 
182
call vert1d &
238
183
!==========
239
 
 (idebia     , idebra     ,                                       &
240
 
  nfabor     , nfpt1d     , iappel    ,                           &
241
 
  ifpt1d     , ia(idebia) , iclt1d    , ia     ,                  &
242
 
  ra(idebra) , ra(idebra) ,                                       &
243
 
  xlmbt1     , rcpt1d     , dtpt1d    , ra      )
 
184
( nfabor , nfpt1d , iappel ,                                      &
 
185
  ifpt1d , ivoid  , iclt1d ,                                      &
 
186
  rvoid  , rvoid  ,                                               &
 
187
  xlmbt1 , rcpt1d , dtpt1d )
244
188
 
245
189
do ii = 1, nfpt1d
246
190