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

« back to all changes in this revision

Viewing changes to src/turb/clipsa.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:
 
1
!-------------------------------------------------------------------------------
 
2
 
 
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.
 
20
 
 
21
!-------------------------------------------------------------------------------
 
22
 
 
23
subroutine clipsa &
 
24
!================
 
25
 
 
26
 ( ncelet , ncel   , nvar   ,                                     &
 
27
   iclip  , iwarnu ,                                              &
 
28
   propce , rtp    )
 
29
 
 
30
!===============================================================================
 
31
! Purpose:
 
32
! --------
 
33
 
 
34
! Clipping of nusa for the Spalart-Allmaras model
 
35
 
 
36
!-------------------------------------------------------------------------------
 
37
! Arguments
 
38
!__________________.____._____.________________________________________________.
 
39
! name             !type!mode ! role                                           !
 
40
!__________________!____!_____!________________________________________________!
 
41
! nvar             ! e  ! <-- ! nombre de variables                            !
 
42
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
 
43
! ncel             ! i  ! <-- ! number of cells                                !
 
44
! iclip            ! e  ! <-- ! indicateur = 0 on utilise viscl0               !
 
45
!                  !    !     !            sinon on utilise viscl              !
 
46
! iwarnu           ! e  ! <-- ! niveau d'impression                            !
 
47
! propce           ! tr ! <-- ! tableaux des variables au pdt courant          !
 
48
!(ncelet,*         !    !     !                                                !
 
49
! rtp              ! tr ! <-- ! tableaux des variables au pdt courant          !
 
50
! (ncelet     )    !    !     !                                                !
 
51
!__________________!____!_____!________________________________________________!
 
52
 
 
53
!     Type: i (integer), r (real), s (string), a (array), l (logical),
 
54
!           and composite types (ex: ra real array)
 
55
!     mode: <-- input, --> output, <-> modifies data, --- work array
 
56
!===============================================================================
 
57
 
 
58
!===============================================================================
 
59
! Module files
 
60
!===============================================================================
 
61
 
 
62
use paramx
 
63
use numvar
 
64
use cstphy
 
65
use cstnum
 
66
use entsor
 
67
use optcal
 
68
use parall
 
69
 
 
70
!===============================================================================
 
71
 
 
72
implicit none
 
73
 
 
74
! Arguments
 
75
 
 
76
integer          nvar, ncelet, ncel
 
77
integer          iclip, iwarnu
 
78
double precision propce(ncelet,*)
 
79
double precision rtp(ncelet,nvar)
 
80
 
 
81
! Local variables
 
82
 
 
83
integer          iclpnu,iel
 
84
integer          ivar,ipp
 
85
double precision xnu, vmin, vmax, var
 
86
double precision epz2
 
87
 
 
88
!===============================================================================
 
89
 
 
90
! Une petite valeur pour eviter des valeurs exactement nulles.
 
91
 
 
92
epz2 = epzero**2
 
93
 
 
94
!===============================================================================
 
95
! ---> Stockage Min et Max pour listing
 
96
!===============================================================================
 
97
 
 
98
ipp  = ipprtp(inusa)
 
99
 
 
100
vmin =  grand
 
101
vmax = -grand
 
102
do iel = 1, ncel
 
103
  var = rtp(iel,inusa)
 
104
  vmin = min(vmin,var)
 
105
  vmax = max(vmax,var)
 
106
enddo
 
107
if (irangp.ge.0) then
 
108
  call parmax (vmax)
 
109
!==========
 
110
  call parmin (vmin)
 
111
!==========
 
112
endif
 
113
varmna(ipp) = vmin
 
114
varmxa(ipp) = vmax
 
115
 
 
116
!===============================================================================
 
117
! ---> Clipping "standard" NUSA>0
 
118
!===============================================================================
 
119
 
 
120
 
 
121
iclpnu = 0
 
122
do iel = 1, ncel
 
123
  xnu = rtp(iel,inusa)
 
124
  if (xnu.lt.0.D0) then
 
125
    iclpnu = iclpnu + 1
 
126
    rtp(iel,inusa) = 0.d0
 
127
  endif
 
128
enddo
 
129
 
 
130
if (irangp.ge.0) then
 
131
  call parcpt (iclpnu)
 
132
!==========
 
133
endif
 
134
 
 
135
! ---  Stockage nb de clippings pour listing
 
136
 
 
137
iclpmn(ipprtp(inusa)) = iclpnu
 
138
 
 
139
 
 
140
!===============================================================================
 
141
! ---> Formats
 
142
!===============================================================================
 
143
 
 
144
#if defined(_CS_LANG_FR)
 
145
 
 
146
 1000 format(                                                           &
 
147
'@                                                            ',/,&
 
148
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
 
149
'@                                                            ',/,&
 
150
'@ @@ ATTENTION : ARRET DANS clipsa                           ',/,&
 
151
'@    =========                                               ',/,&
 
152
'@     APPEL DE clipsa              AVEC OPTION = ',I10        ,/,&
 
153
'@     Phase : ',I10                                           ,/,&
 
154
'@                                                            ',/,&
 
155
'@  Le calcul ne peut pas etre execute.                       ',/,&
 
156
'@                                                            ',/,&
 
157
'@  Contacter l''assistance.                                  ',/,&
 
158
'@                                                            ',/,&
 
159
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
 
160
'@                                                            ',/)
 
161
 1010 format(                                                           &
 
162
 I10,' VALEURS DE NUSA INCORRECTE                            ')
 
163
 
 
164
#else
 
165
 
 
166
 1000 format(                                                           &
 
167
'@                                                            ',/,&
 
168
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
 
169
'@                                                            ',/,&
 
170
'@ @@ WARNING: ABORT IN clipsa                                ',/,&
 
171
'@    ========                                                ',/,&
 
172
'@     CALL OF clipsa               WITH OPTION = ',I10        ,/,&
 
173
'@     Phase : ',I10                                           ,/,&
 
174
'@                                                            ',/,&
 
175
'@  The calulation will not be run.                           ',/,&
 
176
'@                                                            ',/,&
 
177
'@  Contact the support.                                      ',/,&
 
178
'@                                                            ',/,&
 
179
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
 
180
'@                                                            ',/)
 
181
 1010 format(                                                           &
 
182
 I10,' SA    VALUES INCORRECT                       ')
 
183
 
 
184
#endif
 
185
 
 
186
return
 
187
 
 
188
end subroutine