← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/base/dvvpst.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/dvvpst.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 dvvpst &
29
24
!================
30
25
 
31
 
 ( idbia0 , idbra0 , nummai , numtyp ,                            &
32
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
33
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
34
 
   nvar   , nscal  , nphas  , nvlsta , nvisbr ,                   &
 
26
 ( nummai , numtyp ,                                              &
 
27
   nvar   , nscal  , nvlsta , nvisbr ,                            &
35
28
   ncelps , nfacps , nfbrps ,                                     &
36
 
   nideve , nrdeve , nituse , nrtuse ,                            &
37
 
   itypps , ifacel , ifabor , ifmfbr , ifmcel , iprfml ,          &
38
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
 
29
   itypps ,                                                       &
39
30
   lstcel , lstfac , lstfbr ,                                     &
40
 
   idevel , ituser , ia     ,                                     &
41
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
42
31
   dt     , rtpa   , rtp    , propce , propfa , propfb ,          &
43
32
   coefa  , coefb  , statce , stativ , statfb ,                   &
44
 
   tracel , trafac , trafbr , rdevel , rtuser , ra     )
 
33
   tracel , trafac , trafbr ,                                     &
 
34
   ra     )
 
35
 
45
36
!===============================================================================
46
37
! FONCTION :
47
38
! --------
54
45
!__________________.____._____.________________________________________________.
55
46
! name             !type!mode ! role                                           !
56
47
!__________________!____!_____!________________________________________________!
57
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
58
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
59
48
! nummai           ! ec ! <-- ! numero du maillage post                        !
60
49
! numtyp           ! ec ! <-- ! numero de type de post-traitement              !
61
50
!                  !    !     ! (-1: volume, -2: bord, nummai par defaut)      !
62
 
! ndim             ! i  ! <-- ! spatial dimension                              !
63
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
64
 
! ncel             ! i  ! <-- ! number of cells                                !
65
 
! nfac             ! i  ! <-- ! number of interior faces                       !
66
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
67
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
68
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
69
 
! nnod             ! i  ! <-- ! number of vertices                             !
70
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
71
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
72
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
73
51
! nvar             ! i  ! <-- ! total number of variables                      !
74
52
! nscal            ! i  ! <-- ! total number of scalars                        !
75
 
! nphas            ! i  ! <-- ! number of phases                               !
76
53
! nvlsta           ! e  ! <-- ! nombre de variables stat. lagrangien           !
77
54
! nvisbr           ! e  ! <-- ! nombre de statistiques aux frontieres          !
78
55
! ncelps           ! e  ! <-- ! nombre de cellules du maillage post            !
79
56
! nfacps           ! e  ! <-- ! nombre de faces interieur post                 !
80
57
! nfbrps           ! e  ! <-- ! nombre de faces de bord post                   !
81
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
82
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
83
58
! itypps(3)        ! te ! <-- ! indicateur de presence (0 ou 1) de             !
84
59
!                  !    !     ! cellules (1), faces (2), ou faces de           !
85
60
!                  !    !     ! de bord (3) dans le maillage post              !
86
 
! ifacel(2, nfac)  ! ia ! <-- ! interior faces -> cells connectivity           !
87
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
88
 
! ifmfbr(nfabor)   ! ia ! <-- ! boundary face family numbers                   !
89
 
! ifmcel(ncelet)   ! ia ! <-- ! cell family numbers                            !
90
 
! iprfml           ! ia ! <-- ! property numbers per family                    !
91
 
!  (nfml, nprfml)  !    !     !                                                !
92
 
! ipnfac(nfac+1)   ! ia ! <-- ! interior faces -> vertices index (optional)    !
93
 
! nodfac(lndfac)   ! ia ! <-- ! interior faces -> vertices list (optional)     !
94
 
! ipnfbr(nfabor+1) ! ia ! <-- ! boundary faces -> vertices index (optional)    !
95
 
! nodfbr(lndfbr)   ! ia ! <-- ! boundary faces -> vertices list (optional)     !
96
61
! lstcel(ncelps    ! te ! <-- ! liste des cellules du maillage post            !
97
62
! lstfac(nfacps    ! te ! <-- ! liste des faces interieures post               !
98
63
! lstfbr(nfbrps    ! te ! <-- ! liste des faces de bord post                   !
99
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
100
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
101
 
! ia(*)            ! te ! --- ! macro tableau entier                           !
102
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
103
 
!  (ndim, ncelet)  !    !     !                                                !
104
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
105
 
!  (ndim, nfac)    !    !     !                                                !
106
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
107
 
!  (ndim, nfabor)  !    !     !                                                !
108
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
109
 
!  (ndim, nfac)    !    !     !                                                !
110
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
111
 
!  (ndim, nfabor)  !    !     !                                                !
112
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !
113
 
!  (ndim, nnod)    !    !     !                                                !
114
 
! volume           ! tr ! <-- ! volume d'un des ncelet elements                !
115
 
! (ncelet)         !    !     !                                                !
116
64
! dt(ncelet)       ! ra ! <-- ! time step (per cell)                           !
117
65
! rtp, rtpa        ! ra ! <-- ! calculated variables at cell centers           !
118
66
!  (ncelet, *)     !    !     !  (at current and previous time steps)          !
130
78
! tracel(*)        ! tr ! <-- ! tab reel valeurs cellules post                 !
131
79
! trafac(*)        ! tr ! <-- ! tab reel valeurs faces int. post               !
132
80
! trafbr(*)        ! tr ! <-- ! tab reel valeurs faces bord post               !
133
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
134
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
135
81
! ra(*)            ! ra ! --- ! main real work array                           !
136
82
!__________________!____!_____!________________________________________________!
137
83
 
141
87
!            --- tableau de travail
142
88
!===============================================================================
143
89
 
 
90
!===============================================================================
 
91
! Module files
 
92
!===============================================================================
 
93
 
 
94
use paramx
 
95
use pointe
 
96
use entsor
 
97
use cstnum
 
98
use cstphy
 
99
use optcal
 
100
use numvar
 
101
use parall
 
102
use period
 
103
use lagpar
 
104
use lagran
 
105
use ppppar
 
106
use ppthch
 
107
use ppincl
 
108
use radiat
 
109
use cplsat
 
110
use mesh
 
111
 
 
112
!===============================================================================
 
113
 
144
114
implicit none
145
115
 
146
 
!===============================================================================
147
 
! Common blocks
148
 
!===============================================================================
149
 
 
150
 
include "paramx.h"
151
 
include "pointe.h"
152
 
include "entsor.h"
153
 
include "cstnum.h"
154
 
include "cstphy.h"
155
 
include "optcal.h"
156
 
include "numvar.h"
157
 
include "parall.h"
158
 
include "period.h"
159
 
include "lagpar.h"
160
 
include "lagran.h"
161
 
include "ppppar.h"
162
 
include "ppthch.h"
163
 
include "ppincl.h"
164
 
include "radiat.h"
165
 
include "cplsat.h"
166
 
 
167
 
!===============================================================================
168
 
 
169
116
! Arguments
170
117
 
171
 
integer          idbia0 , idbra0
172
118
integer          nummai , numtyp
173
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
174
 
integer          nfml   , nprfml
175
 
integer          nnod   , lndfac , lndfbr , ncelbr
176
 
integer          nvar   , nscal  , nphas  , nvlsta , nvisbr
 
119
integer          nvar   , nscal  , nvlsta , nvisbr
177
120
integer          ncelps , nfacps , nfbrps
178
 
integer          nideve , nrdeve , nituse , nrtuse
179
121
 
180
122
integer          itypps(3)
181
 
integer          ifacel(2,nfac) , ifabor(nfabor)
182
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
183
 
integer          iprfml(nfml,nprfml)
184
 
integer          ipnfac(nfac+1), nodfac(lndfac)
185
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr)
186
123
integer          lstcel(ncelps), lstfac(nfacps), lstfbr(nfbrps)
187
 
integer          idevel(nideve), ituser(nituse), ia(*)
188
124
 
189
 
double precision xyzcen(ndim,ncelet)
190
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
191
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
192
 
double precision xyznod(ndim,nnod), volume(ncelet)
193
125
double precision dt(ncelet), rtpa(ncelet,*), rtp(ncelet,*)
194
126
double precision propce(ncelet,*)
195
127
double precision propfa(nfac,*), propfb(nfabor,*)
198
130
double precision stativ(ncelet,nvlsta)
199
131
double precision tracel(ncelps*3)
200
132
double precision trafac(nfacps*3), trafbr(nfbrps*3)
201
 
double precision rdevel(nrdeve), rtuser(nrtuse)
202
133
double precision ra(*)
203
134
 
204
135
! Local variables
206
137
character*32     namevr, namev1, namev2
207
138
character*80     name80
208
139
 
209
 
integer          idebia, idebra, ifinia, ifinra
210
 
integer          igradx, igrady, igradz
211
 
integer          itravx, itravy, itravz, itreco
212
 
integer          iw1   , iw2
213
 
integer          inc   , iccocg, nswrgp, imligp, iwarnp, iphydp
 
140
integer          inc   , iccocg, nswrgp, imligp, iwarnp
214
141
integer          isorva, isaut
215
 
integer          ifac  , iloc  , iphas , ivar , iclvar
 
142
integer          ifac  , iloc  , ivar , iclvar
216
143
integer          ira   , idivdt, ineeyp
217
144
integer          ipp   , idimt , ii    , kk   , iel
218
 
integer          ivarl , iip   , iph
 
145
integer          ivarl , iip
219
146
integer          iii, ivarl1 , ivarlm , iflu   , ilpd1  , icla
220
147
integer          iscal , ipcvsl, ipcvst, iflmab
221
 
integer          idimte, itenso, ientla, ivarpr
222
 
integer          iyplbp
 
148
integer          ientla, ivarpr
223
149
integer          ipccp , ipcrom
224
150
 
225
 
double precision cp0iph, xcp   , xvsl  , surfbn, distbr
 
151
double precision xcp   , xvsl  , srfbn, distbr
226
152
double precision visct , flumab, diipbx, diipby, diipbz
227
153
double precision epsrgp, climgp, extrap
228
154
double precision omgnrm, daxis2
 
155
 
229
156
double precision rbid(1)
230
157
 
 
158
double precision, allocatable, dimension(:,:) :: grad
 
159
double precision, allocatable, dimension(:) :: treco
231
160
 
232
161
!===============================================================================
233
162
 
234
 
idebia = idbia0
235
 
idebra = idbra0
 
163
! Initialize variables to avoid compiler warnings
 
164
 
 
165
ipp = 0
 
166
 
 
167
! Memoire
 
168
 
236
169
 
237
170
!===============================================================================
238
171
!     1.1. TRAITEMENT POUR LE MAILLAGE FLUIDE
335
268
 
336
269
    call psteva(nummai, namevr, idimt, ientla, ivarpr,            &
337
270
    !==========
338
 
                ntcabs, ttcabs, ra(idipar), rbid, rbid)
 
271
                ntcabs, ttcabs, dispar, rbid, rbid)
339
272
 
340
273
  endif
341
274
 
344
277
  if (ineedy.eq.1 .and. abs(icdpar).eq.1) then
345
278
 
346
279
    ineeyp = 0
347
 
    do iphas = 1, nphas
348
 
      if(itytur(iphas).eq.4.and.idries(iphas).eq.1) then
349
 
        ineeyp = 1
350
 
      endif
351
 
    enddo
 
280
    if(itytur.eq.4.and.idries.eq.1) then
 
281
      ineeyp = 1
 
282
    endif
352
283
 
353
284
    if (ineeyp.eq.1) then
354
285
 
359
290
 
360
291
      call psteva(nummai, namevr, idimt, ientla, ivarpr,          &
361
292
      !==========
362
 
                  ntcabs, ttcabs, ra(iyppar), rbid, rbid)
 
293
                  ntcabs, ttcabs, yplpar, rbid, rbid)
363
294
 
364
295
    endif
365
296
 
369
300
 
370
301
  if (icorio.eq.1) then
371
302
 
372
 
    iphas = 1
373
 
    ipcrom = ipproc(irom(iphas))
 
303
    ipcrom = ipproc(irom)
374
304
    omgnrm = sqrt(omegax**2 + omegay**2 + omegaz**2)
375
305
 
376
306
    NAMEVR = 'Pressure'
388
318
 
389
319
      daxis2 = daxis2 / omgnrm**2
390
320
 
391
 
      tracel(iloc) = rtp(iel,ipr(iphas))                          &
 
321
      tracel(iloc) = rtp(iel,ipr)                          &
392
322
          + 0.5d0*propce(iel,ipcrom)*omgnrm**2*daxis2
393
323
 
394
324
    enddo
407
337
 
408
338
      iel = lstcel(iloc)
409
339
 
410
 
      tracel(1 + (iloc-1)*idimt) = rtp(iel,iu(iphas)) &
 
340
      tracel(1 + (iloc-1)*idimt) = rtp(iel,iu) &
411
341
          + (omegay*xyzcen(3,iel) - omegaz*xyzcen(2,iel))
412
342
 
413
 
      tracel(2 + (iloc-1)*idimt) = rtp(iel,iv(iphas)) &
 
343
      tracel(2 + (iloc-1)*idimt) = rtp(iel,iv) &
414
344
          + (omegaz*xyzcen(1,iel) - omegax*xyzcen(3,iel))
415
345
 
416
 
      tracel(3 + (iloc-1)*idimt) = rtp(iel,iw(iphas)) &
 
346
      tracel(3 + (iloc-1)*idimt) = rtp(iel,iw) &
417
347
          + (omegax*xyzcen(2,iel) - omegay*xyzcen(1,iel))
418
348
 
419
349
    enddo
427
357
 
428
358
  if (imobil.eq.1) then
429
359
 
430
 
    iphas = 1
431
 
    ipcrom = ipproc(irom(iphas))
 
360
    ipcrom = ipproc(irom)
432
361
    omgnrm = sqrt(omegax**2 + omegay**2 + omegaz**2)
433
362
 
434
363
    NAMEVR = 'Rel Pressure'
446
375
 
447
376
      daxis2 = daxis2 / omgnrm**2
448
377
 
449
 
      tracel(iloc) = rtp(iel,ipr(iphas))                          &
 
378
      tracel(iloc) = rtp(iel,ipr)                          &
450
379
          - 0.5d0*propce(iel,ipcrom)*omgnrm**2*daxis2
451
380
 
452
381
    enddo
465
394
 
466
395
      iel = lstcel(iloc)
467
396
 
468
 
      tracel(1 + (iloc-1)*idimt) = rtp(iel,iu(iphas)) &
 
397
      tracel(1 + (iloc-1)*idimt) = rtp(iel,iu) &
469
398
          - (omegay*xyzcen(3,iel) - omegaz*xyzcen(2,iel))
470
399
 
471
 
      tracel(2 + (iloc-1)*idimt) = rtp(iel,iv(iphas)) &
 
400
      tracel(2 + (iloc-1)*idimt) = rtp(iel,iv) &
472
401
          - (omegaz*xyzcen(1,iel) - omegax*xyzcen(3,iel))
473
402
 
474
 
      tracel(3 + (iloc-1)*idimt) = rtp(iel,iw(iphas)) &
 
403
      tracel(3 + (iloc-1)*idimt) = rtp(iel,iw) &
475
404
          - (omegax*xyzcen(2,iel) - omegay*xyzcen(1,iel))
476
405
 
477
406
    enddo
495
424
 
496
425
  if(mod(ipstdv,ipstyp).eq.0) then
497
426
 
498
 
!       Phase
499
 
    do iphas = 1, nphas
500
 
 
501
 
!       Initialisation
502
 
      do ii = 1, 32
503
 
        NAMEVR (II:II) = ' '
504
 
      enddo
505
 
 
506
 
!       Nom de la variable
507
 
      if(nphas.gt.1) then
508
 
        write(namevr,1000)iphas
509
 
 1000         format('YplusPhase',I2.2)
510
 
      else
511
 
        NAMEVR = 'Yplus'
512
 
      endif
513
 
 
514
 
!       Dimension de la variable (3 = vecteur, 1=scalaire)
515
 
      idimt = 1
516
 
 
517
 
!       Calcul des valeurs de la variable sur les faces de bord
518
 
 
519
 
      iyplbp = iyplbr+(iphas-1)*nfabor
520
 
      do iloc = 1, nfbrps
521
 
        ifac = lstfbr(iloc)
522
 
        trafbr(1 + (iloc-1)*idimt) = ra(iyplbp+ifac-1)
523
 
      enddo
524
 
 
525
 
!           Valeurs non entrelac�es, d�finies sur tableau de travail
526
 
      ientla = 0
527
 
      ivarpr = 0
528
 
 
529
 
      call psteva(nummai, namevr, idimt, ientla, ivarpr,          &
530
 
      !==========
531
 
                  ntcabs, ttcabs, rbid, rbid, trafbr)
532
 
 
533
 
    enddo
534
 
!     fin du test sur les phases
 
427
    !       Initialisation
 
428
    do ii = 1, 32
 
429
      NAMEVR (II:II) = ' '
 
430
    enddo
 
431
 
 
432
    !       Nom de la variable
 
433
    NAMEVR = 'Yplus'
 
434
 
 
435
    !       Dimension de la variable (3 = vecteur, 1=scalaire)
 
436
    idimt = 1
 
437
 
 
438
    !       Calcul des valeurs de la variable sur les faces de bord
 
439
 
 
440
    do iloc = 1, nfbrps
 
441
      ifac = lstfbr(iloc)
 
442
      trafbr(1 + (iloc-1)*idimt) = yplbr(ifac)
 
443
    enddo
 
444
 
 
445
    !           Valeurs non entrelac�es, d�finies sur tableau de travail
 
446
    ientla = 0
 
447
    ivarpr = 0
 
448
 
 
449
    call psteva(nummai, namevr, idimt, ientla, ivarpr,          &
 
450
                                !==========
 
451
         ntcabs, ttcabs, rbid, rbid, trafbr)
535
452
 
536
453
  endif
537
454
! fin du test sur sortie de yplus
645
562
 
646
563
  if(mod(ipstdv,ipstft).eq.0) then
647
564
 
648
 
!       Phase
649
 
    do iphas = 1, nphas
650
 
 
651
 
      if(iscalt(iphas).gt.0 .and. nscal.gt.0 .and.                &
652
 
           iscalt(iphas).le.nscal) then
653
 
 
654
 
!       Initialisation
655
 
        do ii = 1, 32
656
 
          NAMEVR (II:II) = ' '
657
 
        enddo
658
 
 
659
 
!       Nom de la variable
660
 
        if(nphas.gt.1) then
661
 
          write(namevr,2000)iphas
662
 
 2000           format('Flux th. entrant W.m-2 Phase',I2.2)
663
 
        else
664
 
          NAMEVR = 'Flux thermique entrant W.m-2'
665
 
        endif
666
 
 
667
 
!       Dimension de la variable (3 = vecteur, 1=scalaire)
668
 
        idimt = 1
669
 
 
670
 
!       Numero de la variable
671
 
 
672
 
        iscal  = iscalt(iphas)
673
 
        ivar   = isca(iscal)
674
 
        iclvar = iclrtp(ivar,icoef)
675
 
 
676
 
!       Calcul des valeurs de la variable sur les faces de bord
677
 
 
678
 
!          Reservation de la memoire pour reconstruction
679
 
 
680
 
        ifinia = idebia
681
 
 
682
 
        igradx = idebra
683
 
        igrady = igradx+ncelet
684
 
        igradz = igrady+ncelet
685
 
        itravx = igradz+ncelet
686
 
        itravy = itravx+ncelet
687
 
        itravz = itravy+ncelet
688
 
        itreco = itravz+ncelet
689
 
        ifinra = itreco+nfabor
690
 
 
691
 
!          Verification de la disponibilite de la memoire
692
 
 
693
 
        CALL IASIZE('DVVPST',IFINIA)
694
 
        CALL RASIZE('DVVPST',IFINRA)
695
 
 
696
 
 
697
 
!          Calcul du gradient de la temperature / enthalpie
698
 
 
699
 
 
700
 
!      Pour calculer le gradient de Temperature
701
 
!        - dans les calculs paralleles, il est necessaire que
702
 
!          les cellules situees sur un bord de sous-domaine connaissent
703
 
!          la valeur de temperature dans les cellules situees en
704
 
!          vis-a-vis sur le sous-domaine voisin.
705
 
!        - dans les calculs periodiques, il est necessaire que
706
 
!          les cellules periodiques aient acces a la valeur de la
707
 
!          temperature des cellules periodiques correspondantes
708
 
 
709
 
!      Pour cela, il est necessaire d'appeler les routines de
710
 
!        communication PARCOM (parallelisme) et PERCOM (periodicite)
711
 
!        pour echanger les valeurs de temperature avant de calculer le
712
 
!        gradient. L'appel a ces routines doit etre fait dans cet ordre
713
 
!        PARCOM puis PERCOM (pour les cas ou parallelisme et periodicite
714
 
!        coexistent).
715
 
!      En effet, on se situe ici a la fin du pas de temps n. Or,
716
 
!        les variables RTP ne seront echangees qu'en debut du pas de
717
 
!        temps n+1. Ici, seules les variables RTPA (obtenues a la fin
718
 
!        du pas de temps n-1) ont deja ete echangees.
719
 
 
720
 
!      Si le calcul n'est ni periodique, ni parallele, on peut conserver
721
 
!        appels (les tests sur IPERIO et IRANGP assurent la generalite)
722
 
 
723
 
 
724
 
!          Echange pour le parallelisme
725
 
 
726
 
        if(irangp.ge.0) then
727
 
 
728
 
          call parcom (rtp(1,ivar))
729
 
          !==========
730
 
 
731
 
        endif
732
 
 
733
 
!          Echange pour la periodicite
734
 
 
735
 
        if(iperio.eq.1) then
736
 
 
737
 
          idimte = 0
738
 
          itenso = 0
739
 
          call percom                                             &
740
 
          !==========
741
 
      ( idimte , itenso ,                                         &
742
 
        rtp(1,ivar), rtp(1,ivar), rtp(1,ivar),                    &
743
 
        rtp(1,ivar), rtp(1,ivar), rtp(1,ivar),                    &
744
 
        rtp(1,ivar), rtp(1,ivar), rtp(1,ivar))
745
 
 
746
 
        endif
747
 
 
748
 
 
749
 
!          Calcul du gradient
750
 
 
751
 
        inc = 1
752
 
        iccocg = 1
753
 
        nswrgp = nswrgr(ivar)
754
 
        imligp = imligr(ivar)
755
 
        iwarnp = iwarni(ivar)
756
 
        epsrgp = epsrgr(ivar)
757
 
        climgp = climgr(ivar)
758
 
        extrap = extrag(ivar)
759
 
        iphydp = 0
760
 
 
761
 
        call grdcel                                               &
 
565
    if(iscalt.gt.0 .and. nscal.gt.0 .and.                &
 
566
         iscalt.le.nscal) then
 
567
 
 
568
      !       Initialisation
 
569
      do ii = 1, 32
 
570
        NAMEVR (II:II) = ' '
 
571
      enddo
 
572
 
 
573
      !       Nom de la variable
 
574
      NAMEVR = 'Flux thermique entrant W.m-2'
 
575
 
 
576
      !       Dimension de la variable (3 = vecteur, 1=scalaire)
 
577
      idimt = 1
 
578
 
 
579
      !       Numero de la variable
 
580
 
 
581
      iscal  = iscalt
 
582
      ivar   = isca(iscal)
 
583
      iclvar = iclrtp(ivar,icoef)
 
584
 
 
585
      !       Calcul des valeurs de la variable sur les faces de bord
 
586
 
 
587
      !          Reservation de la memoire pour reconstruction
 
588
 
 
589
      allocate(treco(nfabor))
 
590
 
 
591
      !          Calcul du gradient de la temperature / enthalpie
 
592
 
 
593
 
 
594
      !      Pour calculer le gradient de Temperature
 
595
      !        - dans les calculs paralleles, il est necessaire que
 
596
      !          les cellules situees sur un bord de sous-domaine connaissent
 
597
      !          la valeur de temperature dans les cellules situees en
 
598
      !          vis-a-vis sur le sous-domaine voisin.
 
599
      !        - dans les calculs periodiques, il est necessaire que
 
600
      !          les cellules periodiques aient acces a la valeur de la
 
601
      !          temperature des cellules periodiques correspondantes
 
602
 
 
603
      !      Pour cela, il est necessaire d'appeler les routines de
 
604
      !        de synchronisation des halos pour echanger les valeurs de temperature
 
605
      !        avant de calculer le gradient.
 
606
      !      En effet, on se situe ici a la fin du pas de temps n. Or,
 
607
      !        les variables RTP ne seront echangees qu'en debut du pas de
 
608
      !        temps n+1. Ici, seules les variables RTPA (obtenues a la fin
 
609
      !        du pas de temps n-1) ont deja ete echangees.
 
610
 
 
611
      !      Si le calcul n'est ni periodique, ni parallele, on peut conserver
 
612
      !        appels (les tests sur IPERIO et IRANGP assurent la generalite)
 
613
 
 
614
 
 
615
      !          Echange pour le parallelisme et la periodicite
 
616
 
 
617
      if (irangp.ge.0.or.iperio.eq.1) then
 
618
        call synsca(rtp(1,ivar))
762
619
        !==========
763
 
 ( ifinia , ifinra ,                                              &
764
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
765
 
   nnod   , lndfac , lndfbr , ncelbr , nphas  ,                   &
766
 
   nideve , nrdeve , nituse , nrtuse ,                            &
767
 
   ivar   , imrgra , inc    , iccocg , nswrgp , imligp , iphydp , &
 
620
      endif
 
621
 
 
622
      ! Allocate a temporary array for the gradient calculation
 
623
      allocate(grad(ncelet,3))
 
624
 
 
625
      !          Calcul du gradient
 
626
 
 
627
      inc = 1
 
628
      iccocg = 1
 
629
      nswrgp = nswrgr(ivar)
 
630
      imligp = imligr(ivar)
 
631
      iwarnp = iwarni(ivar)
 
632
      epsrgp = epsrgr(ivar)
 
633
      climgp = climgr(ivar)
 
634
      extrap = extrag(ivar)
 
635
 
 
636
      call grdcel &
 
637
      !==========
 
638
 ( ivar   , imrgra , inc    , iccocg , nswrgp , imligp ,          &
768
639
   iwarnp , nfecra ,                                              &
769
640
   epsrgp , climgp , extrap ,                                     &
770
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
771
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
772
 
   idevel , ituser , ia     ,                                     &
773
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
774
 
   ra(itravx) , ra(itravx) , ra(itravx) ,                         &
775
641
   rtp(1,ivar) , coefa(1,iclvar) , coefb(1,iclvar) ,              &
776
 
   ra(igradx) , ra(igrady) , ra(igradz) ,                         &
777
 
!        ----------   ----------   ----------
778
 
   ra(itravx) , ra(itravy) , ra(itravz) ,                         &
779
 
   rdevel , rtuser , ra     )
780
 
 
781
 
 
782
 
!          Calcul de la valeur reconstruite dans les cellules de bord
783
 
 
784
 
        do ifac = 1, nfabor
785
 
          iel = ifabor(ifac)
786
 
          iii = idiipb-1+3*(ifac-1)
787
 
          diipbx = ra(iii+1)
788
 
          diipby = ra(iii+2)
789
 
          diipbz = ra(iii+3)
790
 
          ra(itreco+ifac-1) = rtp(iel,ivar)                       &
791
 
               + diipbx*ra(igradx+iel-1)                          &
792
 
               + diipby*ra(igrady+iel-1)                          &
793
 
               + diipbz*ra(igradz+iel-1)
794
 
        enddo
795
 
 
796
 
!          Calcul du flux (ouf          !) convectif et diffusif
797
 
 
798
 
        if(ivisls(iscal).gt.0) then
799
 
          ipcvsl = ipproc(ivisls(iscal))
800
 
        else
801
 
          ipcvsl = 0
802
 
        endif
803
 
        ipcvst = ipproc(ivisct(iphas))
804
 
        iflmab = ipprob(ifluma(ivar))
805
 
 
 
642
   grad   )
 
643
 
 
644
 
 
645
      !          Calcul de la valeur reconstruite dans les cellules de bord
 
646
 
 
647
      do ifac = 1, nfabor
 
648
        iel = ifabor(ifac)
 
649
        diipbx = diipb(1,ifac)
 
650
        diipby = diipb(2,ifac)
 
651
        diipbz = diipb(3,ifac)
 
652
        treco(ifac) = rtp(iel,ivar)                  &
 
653
             + diipbx*grad(iel,1)                          &
 
654
             + diipby*grad(iel,2)                          &
 
655
             + diipbz*grad(iel,3)
 
656
      enddo
 
657
 
 
658
      ! Free memory
 
659
      deallocate(grad)
 
660
      deallocate(treco)
 
661
 
 
662
 
 
663
      !          Calcul du flux (ouf          !) convectif et diffusif
 
664
 
 
665
      if(ivisls(iscal).gt.0) then
 
666
        ipcvsl = ipproc(ivisls(iscal))
 
667
      else
 
668
        ipcvsl = 0
 
669
      endif
 
670
      ipcvst = ipproc(ivisct)
 
671
      iflmab = ipprob(ifluma(ivar))
 
672
 
 
673
      do iloc = 1, nfbrps
 
674
        ifac = lstfbr(iloc)
 
675
        iel = ifabor(ifac)
 
676
 
 
677
        if(ipcvsl.gt.0) then
 
678
          xvsl = propce(iel,ipcvsl)
 
679
        else
 
680
          xvsl = visls0(iscal)
 
681
        endif
 
682
        srfbn = surfbn(ifac)
 
683
        distbr = distb(ifac)
 
684
        visct  = propce(iel,ipcvst)
 
685
        flumab = propfb(ifac,iflmab)
 
686
 
 
687
        trafbr(1 + (iloc-1)*idimt) =                            &
 
688
             (xvsl+visct/sigmas(iscal))/max(distbr,epzero)*     &
 
689
             (coefa(ifac,iclvar)+(coefb(ifac,iclvar)-1.d0)*     &
 
690
             rtp(iel,ivar))                                     &
 
691
             - flumab/max(srfbn,epzero**2)*                    &
 
692
             (coefa(ifac,iclvar)+ coefb(ifac,iclvar)*           &
 
693
             rtp(iel,ivar))
 
694
 
 
695
      enddo
 
696
 
 
697
      !          Pour la temperature, on multiplie par CP
 
698
      if(abs(iscsth(iscal)).eq.1) then
 
699
        if(icp.gt.0) then
 
700
          ipccp  = ipproc(icp   )
 
701
        else
 
702
          ipccp  = 0
 
703
        endif
806
704
        do iloc = 1, nfbrps
807
705
          ifac = lstfbr(iloc)
808
706
          iel = ifabor(ifac)
809
 
 
810
 
          if(ipcvsl.gt.0) then
811
 
            xvsl = propce(iel,ipcvsl)
 
707
          if(ipccp.gt.0) then
 
708
            xcp = propce(iel,ipccp)
812
709
          else
813
 
            xvsl = visls0(iscal)
 
710
            xcp    = cp0
814
711
          endif
815
 
          surfbn = ra(isrfbn-1+ifac)
816
 
          distbr = ra(idistb-1+ifac)
817
 
          visct  = propce(iel,ipcvst)
818
 
          flumab = propfb(ifac,iflmab)
819
 
 
820
 
          trafbr(1 + (iloc-1)*idimt) =                            &
821
 
               (xvsl+visct/sigmas(iscal))/max(distbr,epzero)*     &
822
 
               (coefa(ifac,iclvar)+(coefb(ifac,iclvar)-1.d0)*     &
823
 
               rtp(iel,ivar))                                     &
824
 
               - flumab/max(surfbn,epzero**2)*                    &
825
 
               (coefa(ifac,iclvar)+ coefb(ifac,iclvar)*           &
826
 
               rtp(iel,ivar))
827
 
 
 
712
          trafbr(1 + (iloc-1)*idimt)                            &
 
713
               = xcp*trafbr(1 + (iloc-1)*idimt)
828
714
        enddo
829
 
 
830
 
!          Pour la temperature, on multiplie par CP
831
 
        if(abs(iscsth(iscal)).eq.1) then
832
 
          if(icp(iphas).gt.0) then
833
 
            ipccp  = ipproc(icp   (iphas))
834
 
          else
835
 
            ipccp  = 0
836
 
            cp0iph = cp0(iphas)
837
 
          endif
838
 
          do iloc = 1, nfbrps
839
 
            ifac = lstfbr(iloc)
840
 
            iel = ifabor(ifac)
841
 
            if(ipccp.gt.0) then
842
 
              xcp = propce(iel,ipccp)
843
 
            else
844
 
              xcp    = cp0iph
845
 
            endif
846
 
            trafbr(1 + (iloc-1)*idimt)                            &
847
 
                 = xcp*trafbr(1 + (iloc-1)*idimt)
848
 
          enddo
849
 
        endif
850
 
 
851
 
!             Valeurs entrelac�es, d�finies sur tableau de travail
852
 
        ientla = 1
853
 
        ivarpr = 0
854
 
 
855
 
        call psteva(nummai, namevr, idimt, ientla, ivarpr,        &
856
 
        !==========
857
 
                    ntcabs, ttcabs, rbid, rbid, trafbr)
858
 
 
859
715
      endif
860
 
!         Fin du test sur variable thermique
861
 
 
862
 
    enddo
863
 
!       Fin de boucle sur les phases
 
716
 
 
717
      !             Valeurs entrelac�es, d�finies sur tableau de travail
 
718
      ientla = 1
 
719
      ivarpr = 0
 
720
 
 
721
      call psteva(nummai, namevr, idimt, ientla, ivarpr,        &
 
722
      !==========
 
723
                  ntcabs, ttcabs, rbid, rbid, trafbr)
 
724
 
 
725
    endif
 
726
    !         Fin du test sur variable thermique
864
727
 
865
728
  endif
866
 
!      Fin du test sur sortie des flux thermiques
 
729
  !      Fin du test sur sortie des flux thermiques
867
730
 
868
731
! --    1.2.4 TRAITEMENT DES EFFORTS AUX BORDS
869
732
!       --------------------------------------
885
748
 
886
749
    do iloc = 1, nfbrps
887
750
      ifac = lstfbr(iloc)
888
 
      surfbn = ra(isrfbn-1+ifac)
889
 
      trafbr(1 + (iloc-1)*idimt ) =                               &
890
 
             ra(iforbr+(ifac-1)*idimt  )/surfbn
891
 
      trafbr(2 + (iloc-1)*idimt ) =                               &
892
 
             ra(iforbr+(ifac-1)*idimt+1)/surfbn
893
 
      trafbr(3 + (iloc-1)*idimt ) =                               &
894
 
             ra(iforbr+(ifac-1)*idimt+2)/surfbn
 
751
      srfbn = surfbn(ifac)
 
752
      trafbr(1 + (iloc-1)*idimt ) = forbr(1,ifac)/srfbn
 
753
      trafbr(2 + (iloc-1)*idimt ) = forbr(2,ifac)/srfbn
 
754
      trafbr(3 + (iloc-1)*idimt ) = forbr(3,ifac)/srfbn
895
755
    enddo
896
756
 
897
757
!           Valeurs entrelac�es, d�finies sur tableau de travail
957
817
 
958
818
        call uslaen                                               &
959
819
        !==========
960
 
 ( ifinia , ifinra ,                                              &
961
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
962
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
963
 
   nvar   , nscal  , nphas  , nvlsta ,                            &
964
 
   nideve , nrdeve , nituse , nrtuse ,                            &
 
820
 ( nvar   , nscal  , nvlsta ,                                     &
965
821
   ivarl  , ivarl1 , ivarlm , iflu   , ilpd1  , icla   ,          &
966
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
967
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
968
 
   idevel , ituser , ia     ,                                     &
969
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
970
822
   dt     , rtpa   , rtp    , propce , propfa , propfb ,          &
971
 
   coefa  , coefb  , statce , stativ , tracel ,                   &
972
 
   rdevel , rtuser , ra     )
 
823
   coefa  , coefb  , statce , stativ , tracel )
973
824
 
974
825
!           La variable est deja definie sur le maillage volumique
975
826
!           global ; on utilise donc l'indirection  (donc IVARPR = 1)
1005
856
 
1006
857
        call uslaen                                               &
1007
858
        !==========
1008
 
 ( ifinia , ifinra ,                                              &
1009
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1010
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
1011
 
   nvar   , nscal  , nphas  , nvlsta ,                            &
1012
 
   nideve , nrdeve , nituse , nrtuse ,                            &
 
859
 ( nvar   , nscal  , nvlsta ,                                     &
1013
860
   ivarl  , ivarl1 , ivarlm , iflu   , ilpd1  , icla   ,          &
1014
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
1015
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
1016
 
   idevel , ituser , ia     ,                                     &
1017
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
1018
861
   dt     , rtpa   , rtp    , propce , propfa , propfb ,          &
1019
 
   coefa  , coefb  , statce , stativ , tracel ,                   &
1020
 
   rdevel , rtuser , ra     )
 
862
   coefa  , coefb  , statce , stativ , tracel )
1021
863
 
1022
864
!           La variable est deja definie sur le maillage volumique
1023
865
!           global ; on utilise donc l'indirection  (donc IVARPR = 1)
1092
934
 
1093
935
    enddo
1094
936
 
1095
 
    NAME80 = 'lagrangian_boundary_zones'
1096
 
    namevr = name80(1:32)
1097
 
 
1098
 
    do iloc = 1, nfbrps
1099
 
      ifac = lstfbr(iloc)
1100
 
      trafbr(iloc) = ia(iifrla+ifac-1)
1101
 
    enddo
1102
 
 
1103
 
    idimt  = 1
1104
 
    ientla = 0
1105
 
    ivarpr = 0
1106
 
 
1107
 
    call psteva(nummai, namevr, idimt, ientla, ivarpr,            &
1108
 
         ntcabs, ttcabs, rbid, rbid, trafbr)
 
937
    !NAME80 = 'lagrangian_boundary_zones'
 
938
    !namevr = name80(1:32)
 
939
 
 
940
    !do iloc = 1, nfbrps
 
941
    !  ifac = lstfbr(iloc)
 
942
    !  trafbr(iloc) = ia(iifrla+ifac-1) !! TODO: ifrlag (cf caltri)
 
943
    !enddo
 
944
 
 
945
    !idimt  = 1
 
946
    !ientla = 0
 
947
    !ivarpr = 0
 
948
 
 
949
    !call psteva(nummai, namevr, idimt, ientla, ivarpr,            &
 
950
    !     ntcabs, ttcabs, rbid, rbid, trafbr)
1109
951
 
1110
952
  endif
1111
953
endif
1165
1007
 
1166
1008
    do iloc = 1, nfbrps
1167
1009
      ifac = lstfbr(iloc)
1168
 
      trafbr(iloc) = ia(iizfrd+ifac-1)
 
1010
      trafbr(iloc) = izfrad(ifac)
1169
1011
    enddo
1170
1012
 
1171
1013
    idimt  = 1
1186
1028
    .or. ippmod(ielarc).ge.1                                      &
1187
1029
    .or. ippmod(ielion).ge.1) then
1188
1030
 
1189
 
  ifinia = idebia
1190
 
 
1191
 
  iw1    = idebra
1192
 
  iw2    = iw1    + ncelet*3
1193
 
  ifinra = iw2    + ncelet*3
1194
 
 
1195
 
  CALL RASIZE ('DVVPST', IFINRA)
1196
 
  !==========
1197
 
 
1198
1031
  call uselen                                                     &
1199
1032
  !==========
1200
 
 ( ifinia , ifinra , nummai ,                                     &
1201
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
1202
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
1203
 
   nvar   , nscal  , nphas  ,                                     &
 
1033
 ( nummai ,                                                       &
 
1034
   nvar   , nscal  ,                                              &
1204
1035
   ncelps , nfacps , nfbrps ,                                     &
1205
 
   nideve , nrdeve , nituse , nrtuse ,                            &
1206
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
1207
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
1208
1036
   lstcel , lstfac , lstfbr ,                                     &
1209
 
   idevel , ituser , ia     ,                                     &
1210
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
1211
1037
   dt     , rtpa   , rtp    , propce , propfa , propfb ,          &
1212
1038
   coefa  , coefb  ,                                              &
1213
 
   ra(iw1) , ra(iw2) ,                                            &
1214
 
   tracel , trafac , trafbr , rdevel , rtuser , ra     )
 
1039
   tracel , trafac , trafbr )
1215
1040
 
1216
1041
endif
1217
1042