← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/base/ecrlis.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/ecrlis.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 ecrlis &
29
24
!================
30
25
 
31
 
 ( idbia0 , idbra0 ,                                              &
32
 
   nvar   , nphas  , ndim   , ncelet , ncel   ,                   &
33
 
   nideve , nrdeve , nituse , nrtuse , irtp   ,                   &
34
 
   idevel , ituser , ia     ,                                     &
 
26
 ( nvar   , ndim   , ncelet , ncel   ,                            &
 
27
   irtp   ,                                                       &
35
28
   rtp    , rtpa   , dt     , volume , xyzcen ,                   &
36
 
   rdevel , rtuser , ra     )
 
29
   ra     )
37
30
 
38
31
!===============================================================================
39
32
!  FONCTION  :
46
39
!__________________.____._____.________________________________________________.
47
40
! name             !type!mode ! role                                           !
48
41
!__________________!____!_____!________________________________________________!
49
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
50
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
51
42
! nvar             ! e  ! <-- ! nombre de variables                            !
52
 
! nphas            ! i  ! <-- ! number of phases                               !
53
43
! ndim             ! i  ! <-- ! spatial dimension                              !
54
44
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
55
45
! ncel             ! i  ! <-- ! number of cells                                !
56
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
57
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
58
46
! irtp             ! e  ! <-- ! indice de rtp dans ra                          !
59
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
60
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
61
 
! ia(*)            ! ia ! --- ! main integer work array                        !
62
47
! rtp              ! tr ! <-- ! tableaux des variables au pdt courant          !
63
48
! (ncelet,nvar)    !    !     !                                                !
64
49
! rtpa             ! tr ! <-- ! tableaux des variables au pdt prec             !
68
53
! (ncelet)         !    !     !                                                !
69
54
! xyzcen           ! ra ! <-- ! cell centers                                   !
70
55
!  (ndim, ncelet)  !    !     !                                                !
71
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
72
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
73
56
! ra(*)            ! ra ! --- ! main real work array                           !
74
57
!__________________!____!_____!________________________________________________!
75
58
 
79
62
!            --- tableau de travail
80
63
!===============================================================================
81
64
 
 
65
!===============================================================================
 
66
! Module files
 
67
!===============================================================================
 
68
 
 
69
use paramx
 
70
use numvar
 
71
use entsor
 
72
use optcal
 
73
use cstnum
 
74
use cstphy
 
75
use albase
 
76
use parall
 
77
use ppppar
 
78
use ppthch
 
79
use ppincl
 
80
 
 
81
!===============================================================================
 
82
 
82
83
implicit none
83
84
 
84
 
!===============================================================================
85
 
! Common blocks
86
 
!===============================================================================
87
 
 
88
 
include "paramx.h"
89
 
include "numvar.h"
90
 
include "entsor.h"
91
 
include "optcal.h"
92
 
include "cstnum.h"
93
 
include "parall.h"
94
 
include "cstphy.h"
95
 
include "albase.h"
96
 
include "ppppar.h"
97
 
include "ppthch.h"
98
 
include "ppincl.h"
99
 
 
100
 
!===============================================================================
101
 
 
102
 
integer          idbia0, idbra0, nvar, nphas, ndim, ncelet, ncel
103
 
integer          nideve , nrdeve , nituse , nrtuse
 
85
integer          nvar, ndim, ncelet, ncel
104
86
integer          irtp
105
 
integer          idevel(nideve), ituser(nituse)
106
 
integer          ia(*)
107
87
double precision rtpa(ncelet,nvar), rtp(ncelet,nvar)
108
88
double precision dt(ncelet), volume(ncelet)
109
89
double precision xyzcen(ndim,ncelet)
110
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
 
90
double precision, dimension(*), target :: ra
111
91
 
112
92
! Local variables
113
93
 
114
94
integer          ii, jj, ic, icel, ipp, ira, ivrtp, iok
115
 
integer          iphas, kphas, iprnew, ipuvw
 
95
integer          ipuvw
116
96
integer          icmin, icmax
117
97
integer          nbrval
118
 
integer          idivdt, ixmsdt, idebia, idebra, ifinra, iel
 
98
integer          idivdt, ixmsdt, iel
119
99
double precision petit,xyzmin(3),xyzmax(3)
120
100
character*200    chain, chainc
121
101
 
 
102
double precision, dimension(:), allocatable, target :: momtmp
 
103
double precision, dimension(:), pointer :: varptr => null()
122
104
 
123
105
!===============================================================================
124
106
! 0. INITIALISATIONS LOCALES
125
107
!===============================================================================
126
108
 
127
 
idebia = idbia0
128
 
idebra = idbra0
129
109
 
130
110
petit  =-grand
131
111
 
139
119
    varmax(ipp) = petit
140
120
    ira = abs(ipp2ra(ipp))
141
121
 
142
 
!     Pour les moments, il faut eventuellement diviser par le temps cumule
 
122
    ! For moments, we must divide by the cumulative time
143
123
    idivdt = ippmom(ipp)
144
 
    if(idivdt.eq.0) then
145
 
      ixmsdt = ira
 
124
    if (idivdt.eq.0) then
 
125
      varptr => ra(ira:ira+ncel)
146
126
    else
147
 
      ixmsdt = idebra
148
 
      ifinra = ixmsdt + ncel
149
 
      call rasize ('ecrlis', ifinra)
150
 
      !==========
151
 
    endif
152
 
    if(idivdt.gt.0) then
153
 
      do iel = 1, ncel
154
 
        ra(ixmsdt+iel-1) = ra(ira+iel-1)/ max(ra(idivdt+iel-1),epzero)
155
 
      enddo
156
 
    elseif(idivdt.lt.0) then
157
 
      do iel = 1, ncel
158
 
        ra(ixmsdt+iel-1) = ra(ira+iel-1)/ max(dtcmom(-idivdt),epzero)
159
 
      enddo
160
 
!   else
161
 
!     ra(ixmsdt+iel-1) = ra(ira+iel-1)
162
 
!     inutile car on a pose ixmsdt = ira
 
127
      allocate(momtmp(ncel))
 
128
      varptr => momtmp
 
129
      if (idivdt.gt.0) then
 
130
        do iel = 1, ncel
 
131
          momtmp(iel) = ra(ira+iel-1)/max(ra(idivdt+iel-1),epzero)
 
132
        enddo
 
133
      elseif (idivdt.lt.0) then
 
134
        do iel = 1, ncel
 
135
          momtmp(iel) = ra(ira+iel-1)/max(dtcmom(-idivdt),epzero)
 
136
        enddo
 
137
      endif
163
138
    endif
164
139
 
165
140
    do icel = 1, ncel
166
 
      if(ra(ixmsdt+icel-1).lt.varmin(ipp)) &
167
 
         varmin(ipp) = ra(ixmsdt+icel-1)
168
 
      if(ra(ixmsdt+icel-1).gt.varmax(ipp)) &
169
 
         varmax(ipp) = ra(ixmsdt+icel-1)
 
141
      if(varptr(icel).lt.varmin(ipp)) varmin(ipp) = varptr(icel)
 
142
      if(varptr(icel).gt.varmax(ipp)) varmax(ipp) = varptr(icel)
170
143
    enddo
 
144
 
 
145
    if (idivdt.ne.0) then
 
146
      deallocate(momtmp)
 
147
    endif
 
148
 
171
149
    if (irangp.ge.0) then
172
150
      call parmin (varmin(ipp))
173
151
      !==========
174
152
      call parmax (varmax(ipp))
175
153
      !==========
176
154
    endif
 
155
 
177
156
  endif
178
157
enddo
179
158
 
183
162
 
184
163
do ipp = 2, nvppmx
185
164
  iok = 1
186
 
  do iphas = 1, nphas
187
 
    if(ipp.eq.ipprtp(ipr(iphas))) then
188
 
      iok = 0
189
 
    endif
190
 
  enddo
 
165
  if(ipp.eq.ipprtp(ipr)) then
 
166
    iok = 0
 
167
  endif
191
168
  if(ilisvr(ipp).eq.1.and.itrsvr(ipp).ge.1) then
192
169
    if(iok.eq.1) then
193
170
      ira = abs(ipp2ra(ipp))
205
182
  endif
206
183
enddo
207
184
 
208
 
do iphas = 1, nphas
209
 
  iprnew = 1
210
 
  if(iphas.gt.1) then
211
 
    do kphas = 1, iphas-1
212
 
      if(ipr(iphas).eq.ipr(kphas)) then
213
 
        iprnew = 0
214
 
      endif
215
 
    enddo
216
 
  endif
217
 
  if(iprnew.eq.1) then
218
 
    ipp = ipprtp(ipr(iphas))
219
 
    if(dervar(ipp).lt.epzero) then
220
 
      dervar(ipp) = -1.d0
221
 
    endif
222
 
    dervar(ipp) = rnsmbr(ipp) / dervar(ipp)
223
 
  endif
224
 
enddo
 
185
ipp = ipprtp(ipr)
 
186
if(dervar(ipp).lt.epzero) then
 
187
  dervar(ipp) = -1.d0
 
188
endif
 
189
dervar(ipp) = rnsmbr(ipp) / dervar(ipp)
225
190
 
226
191
 
227
192
!==================================================================
345
310
    chainc(ic:ic+12) = chain(1:12)
346
311
    ic=ic+16
347
312
    ipuvw = 0
348
 
    do iphas = 1, nphas
349
 
      if(ipp.eq.ipprtp(ipr(iphas)) .or.                           &
350
 
         ipp.eq.ipprtp(iu (iphas)) .or.                           &
351
 
         ipp.eq.ipprtp(iv (iphas)) .or.                           &
352
 
         ipp.eq.ipprtp(iw (iphas)) ) then
353
 
        ipuvw = 1
354
 
      endif
355
 
!   En v2f on ne clippe jamais f_barrre, on ne l'affiche donc pas
356
 
      if (iturb(iphas).eq.50) then
357
 
        if (ipp.eq.ipprtp(ifb(iphas))) ipuvw = 1
358
 
      endif
359
 
    enddo
360
 
!   En ALE on ne clippe pas la vitesse de maillage
 
313
    if(ipp.eq.ipprtp(ipr) .or.                           &
 
314
         ipp.eq.ipprtp(iu ) .or.                           &
 
315
         ipp.eq.ipprtp(iv ) .or.                           &
 
316
         ipp.eq.ipprtp(iw ) ) then
 
317
      ipuvw = 1
 
318
    endif
 
319
    !   En v2f phi-fbar on ne clippe jamais f_barre, on ne l'affiche donc pas
 
320
    if (iturb.eq.50) then
 
321
      if (ipp.eq.ipprtp(ifb)) ipuvw = 1
 
322
    endif
 
323
    !   En ALE on ne clippe pas la vitesse de maillage
361
324
    if (iale.eq.1) then
362
325
      if (ipp.eq.ipprtp(iuma) .or.                                &
363
326
          ipp.eq.ipprtp(ivma) .or.                                &
398
361
 
399
362
do ipp = 2, nvppmx
400
363
  ipuvw = 0
401
 
  do iphas = 1, nphas
402
 
    if(ipp.eq.ipprtp(ipr(iphas)) .or.                             &
403
 
       ipp.eq.ipprtp(iu (iphas)) .or.                             &
404
 
       ipp.eq.ipprtp(iv (iphas)) .or.                             &
405
 
       ipp.eq.ipprtp(iw (iphas)) ) then
 
364
  if(ipp.eq.ipprtp(ipr) .or.                             &
 
365
       ipp.eq.ipprtp(iu ) .or.                             &
 
366
       ipp.eq.ipprtp(iv ) .or.                             &
 
367
       ipp.eq.ipprtp(iw ) ) then
 
368
    ipuvw = 1
 
369
  endif
 
370
  !   En v2f on ne clippe jamais f_barrre, on ne l'affiche donc pas
 
371
  if (iturb.eq.50) then
 
372
    if (ipp.eq.ipprtp(ifb)) ipuvw = 1
 
373
  endif
 
374
  !   En ALE on ne clippe pas la vitesse de maillage
 
375
  if (iale.eq.1) then
 
376
    if (ipp.eq.ipprtp(iuma) .or.                                &
 
377
         ipp.eq.ipprtp(ivma) .or.                                &
 
378
         ipp.eq.ipprtp(iwma)) ipuvw = 1
 
379
  endif
 
380
  !   Compressible
 
381
  if(ippmod(icompf).ge.0) then
 
382
    if(ipp.eq.ipprtp(isca(itempk))) then
406
383
      ipuvw = 1
407
384
    endif
408
 
!   En v2f on ne clippe jamais f_barrre, on ne l'affiche donc pas
409
 
    if (iturb(iphas).eq.50) then
410
 
      if (ipp.eq.ipprtp(ifb(iphas))) ipuvw = 1
411
 
    endif
412
 
!   En ALE on ne clippe pas la vitesse de maillage
413
 
    if (iale.eq.1) then
414
 
      if (ipp.eq.ipprtp(iuma) .or.                                &
415
 
          ipp.eq.ipprtp(ivma) .or.                                &
416
 
          ipp.eq.ipprtp(iwma)) ipuvw = 1
417
 
    endif
418
 
!   Compressible
419
 
    if(ippmod(icompf).ge.0) then
420
 
      if(ipp.eq.ipprtp(isca(itempk(iphas)))) then
421
 
        ipuvw = 1
422
 
      endif
423
 
    endif
424
 
  enddo
 
385
  endif
425
386
  if(ilisvr(ipp).eq.1.and.itrsvr(ipp).gt.0.and.ipuvw.eq.0) then
426
387
    chainc = 'a'
427
388
    chain = ' '