← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/mati/mtproj.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/mati/mtproj.f90
1
 
!-------------------------------------------------------------------------------
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
25
 
 
26
 
!-------------------------------------------------------------------------------
27
 
 
28
 
subroutine mtproj &
29
 
!================
30
 
 
31
 
 ( idbia0 , idbra0 ,                                              &
32
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
33
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
34
 
   nvar   , nscal  , nphas  ,                                     &
35
 
   nbpmax , nvp    , nvep   , nivep  , ntersl , nvlsta , nvisbr , &
36
 
   nideve , nrdeve , nituse , nrtuse ,                            &
37
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
38
 
   ipnfac , nodfac , ipnfbr , nodfbr , itepa  ,                   &
39
 
   idevel , ituser , ia     ,                                     &
40
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
41
 
   dt     , rtpa   , rtp    , propce , propfa , propfb ,          &
42
 
   coefa  , coefb  ,                                              &
43
 
   ettp   , ettpa  , tepa   , statis , tslagr , parbor ,          &
44
 
   rdevel , rtuser , ra     )
45
 
 
46
 
!===============================================================================
47
 
! FONCTION :
48
 
! --------
49
 
 
50
 
! MODIFICATION UTILISATEUR EN FIN DE PAS DE TEMPS POUR MATISSE
51
 
 
52
 
!  COPIE ET SPECIALISATION DE USPROJ
53
 
 
54
 
!-------------------------------------------------------------------------------
55
 
! Arguments
56
 
!__________________.____._____.________________________________________________.
57
 
! name             !type!mode ! role                                           !
58
 
!__________________!____!_____!________________________________________________!
59
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
60
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
61
 
! ndim             ! i  ! <-- ! spatial dimension                              !
62
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
63
 
! ncel             ! i  ! <-- ! number of cells                                !
64
 
! nfac             ! i  ! <-- ! number of interior faces                       !
65
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
66
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
67
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
68
 
! nnod             ! i  ! <-- ! number of vertices                             !
69
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
70
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
71
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
72
 
! nvar             ! i  ! <-- ! total number of variables                      !
73
 
! nscal            ! i  ! <-- ! total number of scalars                        !
74
 
! nphas            ! i  ! <-- ! number of phases                               !
75
 
! nbpmax           ! e  ! <-- ! nombre max de particules autorise              !
76
 
! nvp              ! e  ! <-- ! nombre de variables particulaires              !
77
 
! nvep             ! e  ! <-- ! nombre info particulaires (reels)              !
78
 
! nivep            ! e  ! <-- ! nombre info particulaires (entiers)            !
79
 
! ntersl           ! e  ! <-- ! nbr termes sources de couplage retour          !
80
 
! nvlsta           ! e  ! <-- ! nombre de var statistiques lagrangien          !
81
 
! nvisbr           ! e  ! <-- ! nombre de statistiques aux frontieres          !
82
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
83
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
84
 
! ifacel(2, nfac)  ! ia ! <-- ! interior faces -> cells connectivity           !
85
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
86
 
! ifmfbr(nfabor)   ! ia ! <-- ! boundary face family numbers                   !
87
 
! ifmcel(ncelet)   ! ia ! <-- ! cell family numbers                            !
88
 
! iprfml           ! ia ! <-- ! property numbers per family                    !
89
 
!  (nfml, nprfml)  !    !     !                                                !
90
 
! ipnfac           ! te ! <-- ! position du premier noeud de chaque            !
91
 
!   (nfac+1)       !    !     !  face interne dans nodfac (optionnel)          !
92
 
! nodfac           ! te ! <-- ! connectivite faces internes/noeuds             !
93
 
!   (lndfac)       !    !     !  (optionnel)                                   !
94
 
! ipnfbr           ! te ! <-- ! position du premier noeud de chaque            !
95
 
!  (nfabor+1)      !    !     !  face de bord dans nodfbr (optionnel)          !
96
 
! nodfbr           ! te ! <-- ! connectivite faces de bord/noeuds              !
97
 
!   (lndfbr  )     !    !     !  (optionnel)                                   !
98
 
! itepa            ! te ! <-- ! info particulaires (entiers)                   !
99
 
! (nbpmax,nivep    !    !     !   (cellule de la particule,...)                !
100
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
101
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
102
 
! ia(*)            ! ia ! --- ! main integer work array                        !
103
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
104
 
!  (ndim, ncelet)  !    !     !                                                !
105
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
106
 
!  (ndim, nfac)    !    !     !                                                !
107
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
108
 
!  (ndim, nfabor)  !    !     !                                                !
109
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
110
 
!  (ndim, nfac)    !    !     !                                                !
111
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
112
 
!  (ndim, nfabor)  !    !     !                                                !
113
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !
114
 
!  (ndim, nnod)    !    !     !                                                !
115
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !
116
 
! dt(ncelet)       ! ra ! <-- ! time step (per cell)                           !
117
 
! rtp, rtpa        ! ra ! <-- ! calculated variables at cell centers           !
118
 
!  (ncelet, *)     !    !     !  (at current and previous time steps)          !
119
 
! propce(ncelet, *)! ra ! <-- ! physical properties at cell centers            !
120
 
! propfa(nfac, *)  ! ra ! <-- ! physical properties at interior face centers   !
121
 
! propfb(nfabor, *)! ra ! <-- ! physical properties at boundary face centers   !
122
 
! coefa, coefb     ! ra ! <-- ! boundary conditions                            !
123
 
!  (nfabor, *)     !    !     !                                                !
124
 
! ettp             ! tr ! <-- ! tableaux des variables liees                   !
125
 
!  (nbpmax,nvp)    !    !     !   aux particules etape courante                !
126
 
! ettpa            ! tr ! <-- ! tableaux des variables liees                   !
127
 
!  (nbpmax,nvp)    !    !     !   aux particules etape precedente              !
128
 
! tepa             ! tr ! <-- ! info particulaires (reels)                     !
129
 
! (nbpmax,nvep)    !    !     !   (poids statistiques,...)                     !
130
 
! statis           ! tr ! <-- ! moyennes statistiques                          !
131
 
!(ncelet,nvlsta    !    !     !                                                !
132
 
! tslagr           ! tr ! <-- ! terme de couplage retour du                    !
133
 
!(ncelet,ntersl    !    !     !   lagrangien sur la phase porteuse             !
134
 
! parbor           ! tr ! <-- ! infos sur interaction des particules           !
135
 
!(nfabor,nvisbr    !    !     !   aux faces de bord                            !
136
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
137
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
138
 
! ra(*)            ! ra ! --- ! main real work array                           !
139
 
!__________________!____!_____!________________________________________________!
140
 
 
141
 
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
142
 
!            L (LOGIQUE)   .. ET TYPES COMPOSES (EX : TR TABLEAU REEL)
143
 
!     MODE : <-- donnee, --> resultat, <-> Donnee modifiee
144
 
!            --- tableau de travail
145
 
!===============================================================================
146
 
 
147
 
implicit none
148
 
 
149
 
!===============================================================================
150
 
! Common blocks
151
 
!===============================================================================
152
 
 
153
 
include "dimfbr.h"
154
 
include "paramx.h"
155
 
include "pointe.h"
156
 
include "numvar.h"
157
 
include "optcal.h"
158
 
include "cstphy.h"
159
 
include "cstnum.h"
160
 
include "entsor.h"
161
 
include "parall.h"
162
 
include "period.h"
163
 
include "matiss.h"
164
 
 
165
 
!===============================================================================
166
 
 
167
 
! Arguments
168
 
 
169
 
integer          idbia0 , idbra0
170
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
171
 
integer          nfml   , nprfml
172
 
integer          nnod   , lndfac , lndfbr , ncelbr
173
 
integer          nvar   , nscal  , nphas
174
 
integer          nbpmax , nvp    , nvep   , nivep
175
 
integer          ntersl , nvlsta , nvisbr
176
 
integer          nideve , nrdeve , nituse , nrtuse
177
 
 
178
 
integer          ifacel(2,nfac) , ifabor(nfabor)
179
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
180
 
integer          iprfml(nfml,nprfml)
181
 
integer          ipnfac(nfac+1), nodfac(lndfac)
182
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr)
183
 
integer          itepa(nbpmax,nivep)
184
 
integer          idevel(nideve), ituser(nituse)
185
 
integer          ia(*)
186
 
 
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
 
double precision dt(ncelet), rtp(ncelet,*), rtpa(ncelet,*)
192
 
double precision propce(ncelet,*)
193
 
double precision propfa(nfac,*), propfb(ndimfb,*)
194
 
double precision coefa(ndimfb,*), coefb(ndimfb,*)
195
 
double precision ettp(nbpmax,nvp) , ettpa(nbpmax,nvp)
196
 
double precision tepa(nbpmax,nvep)
197
 
double precision statis(ncelet,nvlsta) , tslagr(ncelet,ntersl)
198
 
double precision parbor(nfabor,nvisbr)
199
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
200
 
 
201
 
! Local variables
202
 
 
203
 
integer          idebia , idebra
204
 
integer          iel    , ifac   , ifml   , icoul
205
 
integer          iphas  , iuiph  , iflmab
206
 
double precision ts0    , vs0    , taamax , tpcmax , tppmax
207
 
double precision flmass , bilent , potflo
208
 
 
209
 
!===============================================================================
210
 
! 1. INITIALISATION
211
 
!===============================================================================
212
 
 
213
 
! --- Gestion memoire
214
 
 
215
 
idebia = idbia0
216
 
idebra = idbra0
217
 
 
218
 
! --- Une seule phase
219
 
 
220
 
iphas = 1
221
 
 
222
 
!===============================================================================
223
 
! 1. AFFICHAGES
224
 
!===============================================================================
225
 
 
226
 
 
227
 
! --- Affichages au dernier pas de temps seulement
228
 
 
229
 
if (ntmabs .eq. ntcabs) then
230
 
 
231
 
! --- Nombre de Richardson : calcul et affichage par
232
 
!       . mtimpi en convection forcee
233
 
!       . mttsns en convection naturelle
234
 
 
235
 
 
236
 
! --- Puissance totale
237
 
  if (irangp.le.0) then
238
 
    write(impmat,1001) puitot
239
 
  endif
240
 
 
241
 
 
242
 
! --- Debit enthalpique
243
 
  if (irangp.le.0) then
244
 
    write(impmat,1002) debcon
245
 
  endif
246
 
 
247
 
 
248
 
! --- Coeff d'echange
249
 
  if (irangp.le.0) then
250
 
    write(impmat,1011) cfecca
251
 
    write(impmat,1012) cfecma
252
 
  endif
253
 
 
254
 
! --- Bilan masse en sortie
255
 
!       (la correction par FRDTRA est la correction correspondant
256
 
!        au rapport d'echelle transverse entre le reel et le modele)
257
 
  iuiph  = iu(iphas)
258
 
  iflmab = ipprob(ifluma(iuiph))
259
 
  flmass = 0.d0
260
 
  do ifac = 1, nfabor
261
 
    ifml  = ifmfbr(ifac)
262
 
    icoul = iprfml(ifml,1)
263
 
    if (icoul.eq.icmtfo) then
264
 
      flmass = flmass + propfb(ifac,iflmab)
265
 
    endif
266
 
  enddo
267
 
  flmass = flmass * frdtra
268
 
  if (irangp.ge.0) call parsom(flmass)
269
 
 
270
 
  if (irangp.le.0) then
271
 
    write(impmat,1021) flmass
272
 
  endif
273
 
 
274
 
! --- Temperature moyenne dans la cheminee d'evacuation
275
 
!     (scalaire 1)
276
 
  ts0 = 0.d0
277
 
  vs0 = 0.d0
278
 
  do iel = 1, ncel
279
 
    ifml  = ifmcel(iel   )
280
 
    icoul = iprfml(ifml,1)
281
 
    if(icoul.eq.icmtco) then
282
 
      ts0 = ts0 + volume(iel)*rtp(iel,isca(itaamt))
283
 
      vs0 = vs0 + volume(iel)
284
 
    endif
285
 
  enddo
286
 
  ts0 = ts0/max(vs0,epzero)
287
 
  if (irangp.le.0) then
288
 
    write(impmat,1022) ts0
289
 
  endif
290
 
 
291
 
 
292
 
! --- Calcul du bilan enthalpique en pourcentage
293
 
!       On calcule le rapport de rhoUS * Cp * Delta T (Watt)
294
 
!         a PUITOT (multiplication par 1.D3 car PUITOT est en kW,
295
 
!         division par 100 pour obtenir une donnee en %)
296
 
!       L'ecart de temperature est pris comme l'ecart entre la
297
 
!         temperature de sortie TS0 et la temperature d'entree TINIT
298
 
  bilent =                                                        &
299
 
       cp0(iphas)*flmass*(ts0-tinit)/(puitot*1.d3)*100.d0
300
 
  if (irangp.le.0) then
301
 
    write(impmat,1031) bilent
302
 
  endif
303
 
 
304
 
 
305
 
! --- Calcul du potentiel de flottabilite
306
 
!       Calcul de delta_rho * g * delta_h en Pascal avec, a pression
307
 
!         constante : delta_rho = rho_ref/T_ref * delta_T
308
 
!         D'ou POTFLO = rho_ref/T_ref * delta_T * g * Delta_h
309
 
!       L'ecart de temperature est pris comme l'�cart entre la
310
 
!         temperature de sortie TS0 et la temperature d'entree TINIT
311
 
!       L'ecart de hauteur est pris entre le haut de la cheminee de
312
 
!         sortie et la mi hauteur de la zone de stockage (z=0 au sol)
313
 
  potflo = rrfmat/(trfmat+tkelvi)*(ts0-tinit)                     &
314
 
       * sqrt(gx**2+gy**2+gz**2)*(hcheva-0.5d0*epchel*nchest)
315
 
  if (irangp.le.0) then
316
 
    write(impmat,1032) potflo
317
 
  endif
318
 
 
319
 
 
320
 
! --- Calcul des max des scalaires
321
 
!     . TAA* : Temperature Air Ambiant (scalaire ITAAMT)
322
 
!     . TPC* : Temperature Peau Colis  (scalaire ITPCMT)
323
 
!     . TPP* : Temperature Peau Paroi  (scalaire ITPPMT)
324
 
 
325
 
  taamax = 0.d0
326
 
  tpcmax = 0.d0
327
 
  tppmax = 0.d0
328
 
 
329
 
  do iel = 1, ncel
330
 
    taamax = max(taamax , rtp(iel,isca(itaamt)))
331
 
    tpcmax = max(tpcmax , rtp(iel,isca(itpcmt)))
332
 
    tppmax = max(tppmax , rtp(iel,isca(itppmt)))
333
 
  enddo
334
 
 
335
 
  if (irangp.ge.0) then
336
 
    call parmax(taamax)
337
 
    call parmax(tpcmax)
338
 
    call parmax(tppmax)
339
 
  endif
340
 
 
341
 
  if (irangp.le.0) then
342
 
    write(impmat,1041) taamax
343
 
    write(impmat,1042) tpcmax
344
 
    write(impmat,1043) tppmax
345
 
  endif
346
 
 
347
 
  close(impmat)
348
 
 
349
 
!       Fin du test sur NTCABS
350
 
endif
351
 
 
352
 
 
353
 
!--------
354
 
! FORMATS
355
 
!--------
356
 
 
357
 
 
358
 
 1001 format(' Puissance totale de l''installation                   ', &
359
 
'  :',E12.5, ' kW')
360
 
 1002 format(' Debit enthalpique vers le ciel de l''entrepot         ', &
361
 
'  :',E12.5, ' kW')
362
 
 
363
 
 1011 format(' Coefficient d''echange moyen conteneur/air            ', &
364
 
'  :',E12.5,' W/m2/C')
365
 
 1012 format(' Coefficient d''echange moyen mur/air                  ', &
366
 
'  :',E12.5,' W/m2/C')
367
 
 
368
 
 1021 format(' Debit masse de circulation d''air                     ', &
369
 
'  :',E12.5, ' kg/s')
370
 
 1022 format(' Temperature d''air en sortie                          ', &
371
 
'  :',E12.5, ' �C')
372
 
 
373
 
 1031 format(' Bilan enthalpique                                    ',  &
374
 
'  :',E12.5, ' %')
375
 
 1032 format(' Potentiel de flottabilite                            ',  &
376
 
'  :',E12.5, ' Pa')
377
 
 
378
 
 1041 format(' Temperature maximale d''air ambiant                   ', &
379
 
'  :',E12.5, ' �C')
380
 
 1042 format(' Temperature maximale des conteneurs                  ',  &
381
 
'  :',E12.5, ' �C')
382
 
 1043 format(' Temperature maximale des murs                        ',  &
383
 
'  :',E12.5, ' �C')
384
 
 
385
 
return
386
 
end subroutine