← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/base/testel.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/testel.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-2010 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 testel &
29
24
!================
30
25
 
31
 
 ( idbia0 , idbra0 ,                                              &
32
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
33
 
   nnod   , lndfac , lndfbr , ncelbr , nphas  , nvar   ,          &
34
 
   nideve , nrdeve , nituse , nrtuse ,                            &
35
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
36
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
37
 
   idevel , ituser , ia     ,                                     &
38
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
39
 
   rtp    ,                                                       &
40
 
   coefa  , coefb  ,                                              &
41
 
   rdevel , rtuser , ra     )
 
26
 ( nvar   ,                 &
 
27
   rtp    , coefa  , coefb  )
42
28
 
43
29
!===============================================================================
44
30
! FONCTION :
49
35
!__________________.____._____.________________________________________________.
50
36
! name             !type!mode ! role                                           !
51
37
!__________________!____!_____!________________________________________________!
52
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
53
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
54
 
! ndim             ! i  ! <-- ! spatial dimension                              !
55
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
56
 
! ncel             ! i  ! <-- ! number of cells                                !
57
 
! nfac             ! i  ! <-- ! number of interior faces                       !
58
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
59
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
60
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
61
 
! nnod             ! i  ! <-- ! number of vertices                             !
62
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
63
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
64
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
65
38
! nvar             ! i  ! <-- ! total number of variables                      !
66
39
! nscal            ! i  ! <-- ! total number of scalars                        !
67
 
! nphas            ! i  ! <-- ! number of phases                               !
68
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
69
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
70
 
! ifacel(2, nfac)  ! ia ! <-- ! interior faces -> cells connectivity           !
71
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
72
 
! ifmfbr(nfabor)   ! ia ! <-- ! boundary face family numbers                   !
73
 
! ifmcel(ncelet)   ! ia ! <-- ! cell family numbers                            !
74
 
! iprfml           ! ia ! <-- ! property numbers per family                    !
75
 
!  (nfml, nprfml)  !    !     !                                                !
76
 
! ipnfac(nfac+1)   ! ia ! <-- ! interior faces -> vertices index (optional)    !
77
 
! nodfac(lndfac)   ! ia ! <-- ! interior faces -> vertices list (optional)     !
78
 
! ipnfbr(nfabor+1) ! ia ! <-- ! boundary faces -> vertices index (optional)    !
79
 
! nodfbr(lndfbr)   ! ia ! <-- ! boundary faces -> vertices list (optional)     !
80
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
81
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
82
 
! ia(*)            ! ia ! --- ! main integer work array                        !
83
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
84
 
!  (ndim, ncelet)  !    !     !                                                !
85
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
86
 
!  (ndim, nfac)    !    !     !                                                !
87
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
88
 
!  (ndim, nfabor)  !    !     !                                                !
89
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
90
 
!  (ndim, nfac)    !    !     !                                                !
91
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
92
 
!  (ndim, nfabor)  !    !     !                                                !
93
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !
94
 
!  (ndim, nnod)    !    !     !                                                !
95
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !
96
40
! rtp, rtpa        ! ra ! <-- ! calculated variables at cell centers           !
97
41
!  (ncelet, *)     !    !     !  (at current and previous time steps)          !
98
42
! coefa, coefb     ! ra ! <-- ! boundary conditions                            !
99
43
!  (nfabor, *)     !    !     !                                                !
100
44
! w1,2,3,4,5,6     ! ra ! --- ! work arrays                                    !
101
45
!  (ncelet)        !    !     !  (computation of pressure gradient)            !
102
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
103
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
104
 
! ra(*)            ! ra ! --- ! main real work array                           !
105
46
!__________________!____!_____!________________________________________________!
106
47
 
107
 
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
108
 
!            L (LOGIQUE)   .. ET TYPES COMPOSES (EX : TR TABLEAU REEL)
109
 
!     MODE : <-- donnee, --> resultat, <-> Donnee modifiee
110
 
!            --- tableau de travail
 
48
!     Type: i (integer), r (real), s (string), a (array), l (logical),
 
49
!           and composite types (ex: ra real array)
 
50
!     mode: <-- input, --> output, <-> modifies data, --- work array
 
51
!===============================================================================
 
52
 
 
53
!===============================================================================
 
54
! Module files
 
55
!===============================================================================
 
56
 
 
57
use paramx
 
58
use dimens, only: ndimfb
 
59
use numvar
 
60
use optcal
 
61
use cstphy
 
62
use cstnum
 
63
use pointe
 
64
use entsor
 
65
use albase
 
66
use mesh
 
67
 
111
68
!===============================================================================
112
69
 
113
70
implicit none
114
71
 
115
 
!===============================================================================
116
 
! Common blocks
117
 
!===============================================================================
118
 
 
119
 
include "dimfbr.h"
120
 
include "paramx.h"
121
 
include "numvar.h"
122
 
include "optcal.h"
123
 
include "cstphy.h"
124
 
include "cstnum.h"
125
 
include "pointe.h"
126
 
include "entsor.h"
127
 
include "albase.h"
128
 
 
129
 
!===============================================================================
130
 
 
131
72
! Arguments
132
73
 
133
 
integer          idbia0 , idbra0
134
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
135
 
integer          nfml   , nprfml
136
 
integer          nnod   , lndfac , lndfbr , ncelbr , nphas , nvar
137
 
integer          nideve , nrdeve , nituse , nrtuse
138
 
 
139
 
integer          ifacel(2,nfac) , ifabor(nfabor)
140
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
141
 
integer          iprfml(nfml,nprfml)
142
 
integer          ipnfac(nfac+1), nodfac(lndfac)
143
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr)
144
 
integer          idevel(nideve), ituser(nituse)
145
 
integer          ia(*)
146
 
 
147
 
double precision xyzcen(ndim,ncelet)
148
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
149
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
150
 
double precision xyznod(ndim,nnod), volume(ncelet)
 
74
integer          nvar
 
75
 
 
76
 
151
77
double precision rtp(ncelet,*)
152
78
double precision coefa(ndimfb,*), coefb(ndimfb,*)
153
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
154
79
 
155
80
! Local variables
156
81
 
157
 
integer          idebia, idebra, ifinia, ifinra
158
 
integer          ifac  , iel   , ivar  , iphas
159
 
integer          inc   , iccocg, iphydp
160
 
integer          iuiph , iviph , iwiph
 
82
integer          ntpost
 
83
integer          ifac  , iel   , ivar
 
84
integer          inc   , iccocg
161
85
integer          nswrgp, imligp, iwarnp
162
 
integer          ipclip
163
 
integer          iw1   , iw2   , iw3
 
86
integer          ipclip, ialold
164
87
integer          indwri, indact, ipart, idimt, ientla, ivarpr
165
88
 
 
89
double precision ttpost
166
90
double precision epsrgp, climgp, extrap
167
91
double precision xx, yy, zz
168
92
double precision rbid(1)
169
93
 
170
94
character*32     namevr
171
95
 
 
96
double precision, allocatable, dimension(:,:) :: grad
 
97
 
172
98
!===============================================================================
173
99
 
174
100
!===============================================================================
175
101
! 0.  INITIALISATIONS
176
102
!===============================================================================
177
103
 
178
 
ifinia = idbia0
 
104
! Allocate temporary arrays
 
105
allocate(grad(ncelet,3))
179
106
 
180
107
! On positionne l'indicateur ALE a 1 de maniere a forcer le recalcul
181
108
! de la contribution des cellules de bord a chaque appel de GRDCEL
 
109
ialold = iale
182
110
iale = 1
183
111
 
184
 
iw1    = idbra0
185
 
iw2    = iw1    + ncelet
186
 
iw3    = iw2    + ncelet
187
 
ifinra = iw3    + ncelet
188
 
 
189
 
CALL RASIZE('TESTEL',IFINRA)
190
 
!==========
 
112
! Postprocessing should be time-independent
 
113
ntpost = -1
 
114
ttpost = 0.d0
191
115
 
192
116
! Symmetry type:
193
117
! value 0 avoids extrapolating the gradient on boundary faces.
194
118
do ifac = 1, nfabor
195
 
   ia(iisymp-1+ifac) = 0
 
119
   isympa(ifac) = 0
196
120
enddo
197
121
 
198
122
!===============================================================================
199
123
! 1. FONCTION ANALYTIQUE SIN(X+2Y+3Z)
200
124
!===============================================================================
201
125
 
202
 
iphas = 1
203
 
iuiph = iu(iphas)
204
 
iviph = iv(iphas)
205
 
iwiph = iw(iphas)
206
 
 
207
 
ivar   = ipr(iphas)
 
126
ivar   = ipr
208
127
ipclip = iclrtp(ivar,icoef)
209
128
 
210
129
do iel = 1, ncelet
258
177
epsrgp = epsrgr(ivar)
259
178
climgp = climgr(ivar)
260
179
extrap = extrag(ivar)
261
 
iphydp = 0
262
180
 
263
181
!  2.1 APPEL A GRDCEL AVEC IMRGRA = 0
264
182
!  ==================================
266
184
imrgra = 0
267
185
imligp = -1
268
186
 
269
 
call grdcel                                                       &
 
187
call grdcel &
270
188
!==========
271
 
 ( ifinia , ifinra ,                                              &
272
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
273
 
   nnod   , lndfac , lndfbr , ncelbr , nphas  ,                   &
274
 
   nideve , nrdeve , nituse , nrtuse ,                            &
275
 
   ivar   , imrgra , inc    , iccocg , nswrgp , imligp ,  iphydp ,&
 
189
 ( ivar   , imrgra , inc    , iccocg , nswrgp , imligp ,          &
276
190
   iwarnp , nfecra ,                                              &
277
191
   epsrgp , climgp , extrap ,                                     &
278
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
279
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
280
 
   idevel , ituser , ia     ,                                     &
281
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
282
 
   ra(iw1), ra(iw1), ra(iw1),                                     &
283
192
   rtp(1,ivar)     , coefa(1,ipclip) , coefb(1,ipclip) ,          &
284
 
   rtp(1,iuiph)    , rtp(1,iviph)    , rtp(1,iwiph)    ,          &
285
 
   ra(iw1), ra(iw2), ra(iw3),                                     &
286
 
   rdevel , rtuser , ra     )
 
193
   grad   )
287
194
 
288
195
! On sort le gradient
289
196
 
290
 
NAMEVR = 'Grad_RC'
291
 
if (ichrvl.eq.1) then
292
 
  call psteva(ipart , namevr, idimt, ientla, ivarpr,    &
293
 
  !==========
294
 
              ntcabs, ttcabs, rtp(1,iuiph), rbid, rbid)
295
 
endif
 
197
namevr = 'Grad_RC'
 
198
call psteva(ipart , namevr, idimt, ientla, ivarpr,    &
 
199
!==========
 
200
            ntpost, ttpost, grad, rbid, rbid)
296
201
 
297
202
! Calcul de l'erreur absolue
298
203
 
300
205
  xx = xyzcen(1,iel)
301
206
  yy = xyzcen(2,iel)
302
207
  zz = xyzcen(3,iel)
303
 
  rtp(iel,iuiph) = rtp(iel,iuiph)-     cos(xx+2.d0*yy+3.d0*zz)
304
 
  rtp(iel,iviph) = rtp(iel,iviph)-2.d0*cos(xx+2.d0*yy+3.d0*zz)
305
 
  rtp(iel,iwiph) = rtp(iel,iwiph)-3.d0*cos(xx+2.d0*yy+3.d0*zz)
 
208
  grad(iel,1) = grad(iel,1)-     cos(xx+2.d0*yy+3.d0*zz)
 
209
  grad(iel,2) = grad(iel,2)-2.d0*cos(xx+2.d0*yy+3.d0*zz)
 
210
  grad(iel,3) = grad(iel,3)-3.d0*cos(xx+2.d0*yy+3.d0*zz)
306
211
enddo
307
212
 
308
213
! On sort l'erreur
309
214
 
310
 
NAMEVR = 'Err_Grad_RC'
311
 
if (ichrvl.eq.1) then
312
 
  call psteva(ipart , namevr, idimt, ientla, ivarpr,    &
313
 
  !==========
314
 
              ntcabs, ttcabs, rtp(1,iuiph), rbid, rbid)
315
 
endif
 
215
namevr = 'Err_Grad_RC'
 
216
call psteva(ipart , namevr, idimt, ientla, ivarpr,    &
 
217
!==========
 
218
            ntpost, ttpost, grad, rbid, rbid)
316
219
 
317
220
 
318
221
!  2.2 APPEL A GRDCEL AVEC IMRGRA = 1
321
224
imrgra = 1
322
225
imligp = 1
323
226
 
324
 
call grdcel                                                       &
 
227
call grdcel &
325
228
!==========
326
 
 ( ifinia , ifinra ,                                              &
327
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
328
 
   nnod   , lndfac , lndfbr , ncelbr , nphas  ,                   &
329
 
   nideve , nrdeve , nituse , nrtuse ,                            &
330
 
   ivar   , imrgra , inc    , iccocg , nswrgp , imligp ,  iphydp ,&
 
229
 ( ivar   , imrgra , inc    , iccocg , nswrgp , imligp ,          &
331
230
   iwarnp , nfecra ,                                              &
332
231
   epsrgp , climgp , extrap ,                                     &
333
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
334
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
335
 
   idevel , ituser , ia     ,                                     &
336
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
337
 
   ra(iw1), ra(iw1), ra(iw1),                                     &
338
232
   rtp(1,ivar)     , coefa(1,ipclip) , coefb(1,ipclip) ,          &
339
 
   rtp(1,iuiph)    , rtp(1,iviph)    , rtp(1,iwiph)    ,          &
340
 
   ra(iw1), ra(iw2), ra(iw3),                                     &
341
 
   rdevel , rtuser , ra     )
342
 
 
 
233
   grad   )
343
234
 
344
235
! On sort le gradient
345
236
 
346
 
NAMEVR = 'Grad_LSQ'
347
 
if (ichrvl.eq.1) then
348
 
  call psteva(ipart , namevr, idimt, ientla, ivarpr,    &
349
 
  !==========
350
 
              ntcabs, ttcabs, rtp(1,iuiph), rbid, rbid)
351
 
endif
 
237
namevr = 'Grad_LSQ'
 
238
call psteva(ipart , namevr, idimt, ientla, ivarpr,    &
 
239
!==========
 
240
            ntpost, ttpost, grad, rbid, rbid)
352
241
 
353
242
! Calcul de l'erreur absolue
354
243
 
356
245
  xx = xyzcen(1,iel)
357
246
  yy = xyzcen(2,iel)
358
247
  zz = xyzcen(3,iel)
359
 
  rtp(iel,iuiph) = rtp(iel,iuiph)-     cos(xx+2.d0*yy+3.d0*zz)
360
 
  rtp(iel,iviph) = rtp(iel,iviph)-2.d0*cos(xx+2.d0*yy+3.d0*zz)
361
 
  rtp(iel,iwiph) = rtp(iel,iwiph)-3.d0*cos(xx+2.d0*yy+3.d0*zz)
 
248
  grad(iel,1) = grad(iel,1)-     cos(xx+2.d0*yy+3.d0*zz)
 
249
  grad(iel,2) = grad(iel,2)-2.d0*cos(xx+2.d0*yy+3.d0*zz)
 
250
  grad(iel,3) = grad(iel,3)-3.d0*cos(xx+2.d0*yy+3.d0*zz)
362
251
enddo
363
252
 
364
253
! On sort l'erreur
365
254
 
366
 
NAMEVR = 'Err_Grad_LSQ'
367
 
if (ichrvl.eq.1) then
368
 
  call psteva(ipart , namevr, idimt, ientla, ivarpr,    &
369
 
  !==========
370
 
              ntcabs, ttcabs, rtp(1,iuiph), rbid, rbid)
371
 
endif
 
255
namevr = 'Err_Grad_LSQ'
 
256
call psteva(ipart , namevr, idimt, ientla, ivarpr,    &
 
257
!==========
 
258
            ntpost, ttpost, grad, rbid, rbid)
372
259
 
373
260
 
374
261
!  2.3 APPEL A GRDCEL AVEC IMRGRA = 2
377
264
imrgra = 2
378
265
imligp = 1
379
266
 
380
 
call grdcel                                                       &
 
267
call grdcel &
381
268
!==========
382
 
 ( ifinia , ifinra ,                                              &
383
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
384
 
   nnod   , lndfac , lndfbr , ncelbr , nphas  ,                   &
385
 
   nideve , nrdeve , nituse , nrtuse ,                            &
386
 
   ivar   , imrgra , inc    , iccocg , nswrgp , imligp ,  iphydp ,&
 
269
 ( ivar   , imrgra , inc    , iccocg , nswrgp , imligp ,          &
387
270
   iwarnp , nfecra ,                                              &
388
271
   epsrgp , climgp , extrap ,                                     &
389
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
390
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
391
 
   idevel , ituser , ia     ,                                     &
392
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
393
 
   ra(iw1), ra(iw1), ra(iw1),                                     &
394
272
   rtp(1,ivar)     , coefa(1,ipclip) , coefb(1,ipclip) ,          &
395
 
   rtp(1,iuiph)    , rtp(1,iviph)    , rtp(1,iwiph)    ,          &
396
 
   ra(iw1), ra(iw2), ra(iw3),                                     &
397
 
   rdevel , rtuser , ra     )
 
273
   grad   )
398
274
 
399
275
! On sort le gradient
400
276
 
401
 
NAMEVR = 'Grad_LSQ_Ext'
402
 
if (ichrvl.eq.1) then
403
 
  call psteva(ipart , namevr, idimt, ientla, ivarpr,    &
404
 
  !==========
405
 
              ntcabs, ttcabs, rtp(1,iuiph), rbid, rbid)
406
 
endif
 
277
namevr = 'Grad_LSQ_Ext'
 
278
call psteva(ipart , namevr, idimt, ientla, ivarpr,    &
 
279
!==========
 
280
            ntpost, ttpost, grad, rbid, rbid)
407
281
 
408
282
! Calcul de l'erreur absolue
409
283
 
411
285
  xx = xyzcen(1,iel)
412
286
  yy = xyzcen(2,iel)
413
287
  zz = xyzcen(3,iel)
414
 
  rtp(iel,iuiph) = rtp(iel,iuiph)-     cos(xx+2.d0*yy+3.d0*zz)
415
 
  rtp(iel,iviph) = rtp(iel,iviph)-2.d0*cos(xx+2.d0*yy+3.d0*zz)
416
 
  rtp(iel,iwiph) = rtp(iel,iwiph)-3.d0*cos(xx+2.d0*yy+3.d0*zz)
 
288
  grad(iel,1) = grad(iel,1)-     cos(xx+2.d0*yy+3.d0*zz)
 
289
  grad(iel,2) = grad(iel,2)-2.d0*cos(xx+2.d0*yy+3.d0*zz)
 
290
  grad(iel,3) = grad(iel,3)-3.d0*cos(xx+2.d0*yy+3.d0*zz)
417
291
enddo
418
292
 
419
293
! On sort l'erreur
420
294
 
421
 
NAMEVR = 'Err_Grad_LSQ_Ext'
422
 
if (ichrvl.eq.1) then
423
 
  call psteva(ipart , namevr, idimt, ientla, ivarpr,    &
424
 
  !==========
425
 
              ntcabs, ttcabs, rtp(1,iuiph), rbid, rbid)
426
 
endif
 
295
namevr = 'Err_Grad_LSQ_Ext'
 
296
call psteva(ipart , namevr, idimt, ientla, ivarpr,    &
 
297
!==========
 
298
              ntpost, ttpost, grad, rbid, rbid)
427
299
 
428
300
 
429
301
!  2.4 APPEL A GRDCEL AVEC IMRGRA = 4
432
304
imrgra = 4
433
305
imligp = -1
434
306
 
435
 
call grdcel                                                       &
 
307
call grdcel &
436
308
!==========
437
 
 ( ifinia , ifinra ,                                              &
438
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
439
 
   nnod   , lndfac , lndfbr , ncelbr , nphas  ,                   &
440
 
   nideve , nrdeve , nituse , nrtuse ,                            &
441
 
   ivar   , imrgra , inc    , iccocg , nswrgp , imligp ,  iphydp ,&
 
309
 ( ivar   , imrgra , inc    , iccocg , nswrgp , imligp ,          &
442
310
   iwarnp , nfecra ,                                              &
443
311
   epsrgp , climgp , extrap ,                                     &
444
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
445
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
446
 
   idevel , ituser , ia     ,                                     &
447
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
448
 
   ra(iw1), ra(iw1), ra(iw1),                                     &
449
312
   rtp(1,ivar)     , coefa(1,ipclip) , coefb(1,ipclip) ,          &
450
 
   rtp(1,iuiph)    , rtp(1,iviph)    , rtp(1,iwiph)    ,          &
451
 
   ra(iw1), ra(iw2), ra(iw3),                                     &
452
 
   rdevel , rtuser , ra     )
 
313
   grad   )
453
314
 
454
315
! On sort le gradient
455
316
 
456
 
NAMEVR = 'Grad_LSQ_RC'
457
 
if (ichrvl.eq.1) then
458
 
  call psteva(ipart , namevr, idimt, ientla, ivarpr,    &
459
 
  !==========
460
 
              ntcabs, ttcabs, rtp(1,iuiph), rbid, rbid)
461
 
endif
 
317
namevr = 'Grad_LSQ_RC'
 
318
call psteva(ipart , namevr, idimt, ientla, ivarpr,    &
 
319
!==========
 
320
            ntpost, ttpost, grad, rbid, rbid)
462
321
 
463
322
! Calcul de l'erreur absolue
464
323
 
466
325
  xx = xyzcen(1,iel)
467
326
  yy = xyzcen(2,iel)
468
327
  zz = xyzcen(3,iel)
469
 
  rtp(iel,iuiph) = rtp(iel,iuiph)-     cos(xx+2.d0*yy+3.d0*zz)
470
 
  rtp(iel,iviph) = rtp(iel,iviph)-2.d0*cos(xx+2.d0*yy+3.d0*zz)
471
 
  rtp(iel,iwiph) = rtp(iel,iwiph)-3.d0*cos(xx+2.d0*yy+3.d0*zz)
 
328
  grad(iel,1) = grad(iel,1)-     cos(xx+2.d0*yy+3.d0*zz)
 
329
  grad(iel,2) = grad(iel,2)-2.d0*cos(xx+2.d0*yy+3.d0*zz)
 
330
  grad(iel,3) = grad(iel,3)-3.d0*cos(xx+2.d0*yy+3.d0*zz)
472
331
enddo
473
332
 
474
333
! On sort l'erreur
475
334
 
476
 
NAMEVR = 'Err_Grad_LSQ_RC'
477
 
if (ichrvl.eq.1) then
478
 
  call psteva(ipart , namevr, idimt, ientla, ivarpr,    &
479
 
  !==========
480
 
              ntcabs, ttcabs, rtp(1,iuiph), rbid, rbid)
481
 
endif
 
335
namevr = 'Err_Grad_LSQ_RC'
 
336
call psteva(ipart , namevr, idimt, ientla, ivarpr,    &
 
337
!==========
 
338
            ntpost, ttpost, grad, rbid, rbid)
482
339
 
483
340
 
484
341
!  2.5 APPEL A GRDCEL AVEC IMRGRA = 3
492
349
imrgra = 3
493
350
imligp = 1
494
351
 
495
 
call grdcel                                                       &
 
352
call grdcel &
496
353
!==========
497
 
 ( ifinia , ifinra ,                                              &
498
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
499
 
   nnod   , lndfac , lndfbr , ncelbr , nphas  ,                   &
500
 
   nideve , nrdeve , nituse , nrtuse ,                            &
501
 
   ivar   , imrgra , inc    , iccocg , nswrgp , imligp ,  iphydp ,&
 
354
 ( ivar   , imrgra , inc    , iccocg , nswrgp , imligp ,          &
502
355
   iwarnp , nfecra ,                                              &
503
356
   epsrgp , climgp , extrap ,                                     &
504
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
505
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
506
 
   idevel , ituser , ia     ,                                     &
507
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
508
 
   ra(iw1), ra(iw1), ra(iw1),                                     &
509
357
   rtp(1,ivar)     , coefa(1,ipclip) , coefb(1,ipclip) ,          &
510
 
   rtp(1,iuiph)    , rtp(1,iviph)    , rtp(1,iwiph)    ,          &
511
 
   ra(iw1), ra(iw2), ra(iw3),                                     &
512
 
   rdevel , rtuser , ra     )
 
358
   grad   )
513
359
 
514
360
! On sort le gradient
515
361
 
516
 
NAMEVR = 'Grad_LSQ_ExtRed'
517
 
if (ichrvl.eq.1) then
518
 
  call psteva(ipart , namevr, idimt, ientla, ivarpr,    &
519
 
  !==========
520
 
              ntcabs, ttcabs, rtp(1,iuiph), rbid, rbid)
521
 
endif
 
362
namevr = 'Grad_LSQ_ExtRed'
 
363
call psteva(ipart , namevr, idimt, ientla, ivarpr,    &
 
364
!==========
 
365
            ntpost, ttpost, grad, rbid, rbid)
522
366
 
523
367
! Calcul de l'erreur absolue
524
368
 
526
370
  xx = xyzcen(1,iel)
527
371
  yy = xyzcen(2,iel)
528
372
  zz = xyzcen(3,iel)
529
 
  rtp(iel,iuiph) = rtp(iel,iuiph)-     cos(xx+2.d0*yy+3.d0*zz)
530
 
  rtp(iel,iviph) = rtp(iel,iviph)-2.d0*cos(xx+2.d0*yy+3.d0*zz)
531
 
  rtp(iel,iwiph) = rtp(iel,iwiph)-3.d0*cos(xx+2.d0*yy+3.d0*zz)
 
373
  grad(iel,1) = grad(iel,1)-     cos(xx+2.d0*yy+3.d0*zz)
 
374
  grad(iel,2) = grad(iel,2)-2.d0*cos(xx+2.d0*yy+3.d0*zz)
 
375
  grad(iel,3) = grad(iel,3)-3.d0*cos(xx+2.d0*yy+3.d0*zz)
532
376
enddo
533
377
 
534
378
! On sort l'erreur
535
379
 
536
 
NAMEVR = 'Err_Grad_LSQ_ExtRed'
537
 
if (ichrvl.eq.1) then
538
 
  call psteva(ipart , namevr, idimt, ientla, ivarpr,    &
539
 
  !==========
540
 
              ntcabs, ttcabs, rtp(1,iuiph), rbid, rbid)
541
 
endif
 
380
namevr = 'Err_Grad_LSQ_ExtRed'
 
381
call psteva(ipart , namevr, idimt, ientla, ivarpr,    &
 
382
!==========
 
383
            ntpost, ttpost, grad, rbid, rbid)
 
384
 
 
385
! Reset ALE flag to old value
 
386
! de la contribution des cellules de bord a chaque appel de GRDCEL
 
387
iale = ialold
 
388
 
 
389
! Free memory
 
390
deallocate(grad)
542
391
 
543
392
!----
544
393
! FIN