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

« back to all changes in this revision

Viewing changes to users/elec/uselen.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:
2
2
 
3
3
!VERS
4
4
 
5
 
 
6
 
!     This file is part of the Code_Saturne Kernel, element of the
7
 
!     Code_Saturne CFD tool.
8
 
 
9
 
!     Copyright (C) 1998-2009 EDF S.A., France
10
 
 
11
 
!     contact: saturne-support@edf.fr
12
 
 
13
 
!     The Code_Saturne Kernel is free software; you can redistribute it
14
 
!     and/or modify it under the terms of the GNU General Public License
15
 
!     as published by the Free Software Foundation; either version 2 of
16
 
!     the License, or (at your option) any later version.
17
 
 
18
 
!     The Code_Saturne Kernel is distributed in the hope that it will be
19
 
!     useful, but WITHOUT ANY WARRANTY; without even the implied warranty
20
 
!     of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
21
 
!     GNU General Public License for more details.
22
 
 
23
 
!     You should have received a copy of the GNU General Public License
24
 
!     along with the Code_Saturne Kernel; if not, write to the
25
 
!     Free Software Foundation, Inc.,
26
 
!     51 Franklin St, Fifth Floor,
27
 
!     Boston, MA  02110-1301  USA
 
5
! This file is part of Code_Saturne, a general-purpose CFD tool.
 
6
!
 
7
! Copyright (C) 1998-2011 EDF S.A.
 
8
!
 
9
! This program is free software; you can redistribute it and/or modify it under
 
10
! the terms of the GNU General Public License as published by the Free Software
 
11
! Foundation; either version 2 of the License, or (at your option) any later
 
12
! version.
 
13
!
 
14
! This program is distributed in the hope that it will be useful, but WITHOUT
 
15
! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
 
16
! FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
 
17
! details.
 
18
!
 
19
! You should have received a copy of the GNU General Public License along with
 
20
! this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
 
21
! Street, Fifth Floor, Boston, MA 02110-1301, USA.
28
22
 
29
23
!-------------------------------------------------------------------------------
30
24
 
31
25
subroutine uselen &
32
26
!================
33
27
 
34
 
 ( idbia0 , idbra0 , nummai ,                                     &
35
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
36
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
37
 
   nvar   , nscal  , nphas  ,                                     &
 
28
 ( nummai ,                                                       &
 
29
   nvar   , nscal  ,                                              &
38
30
   ncelps , nfacps , nfbrps ,                                     &
39
 
   nideve , nrdeve , nituse , nrtuse ,                            &
40
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
41
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
42
31
   lstcel , lstfac , lstfbr ,                                     &
43
 
   idevel , ituser , ia     ,                                     &
44
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
45
32
   dt     , rtpa   , rtp    , propce , propfa , propfb ,          &
46
33
   coefa  , coefb  ,                                              &
47
 
   w1     , w2     ,                                              &
48
 
   tracel , trafac , trafbr , rdevel , rtuser , ra     )
 
34
   tracel , trafac , trafbr )
49
35
 
50
36
!===============================================================================
51
37
! Purpose :
58
44
!__________________.____._____.________________________________________________.
59
45
!    nom           !type!mode !                   role                         !
60
46
!__________________!____!_____!________________________________________________!
61
 
! idbia0           ! e  ! <-- ! numero de la 1ere case libre dans ia           !
62
 
! idbra0           ! e  ! <-- ! numero de la 1ere case libre dans ra           !
63
47
! nummai           ! ec ! <-- ! numero du maillage post                        !
64
 
! ndim             ! e  ! <-- ! dimension de l'espace                          !
65
 
! ncelet           ! e  ! <-- ! nombre d'elements halo compris                 !
66
 
! ncel             ! e  ! <-- ! nombre d'elements actifs                       !
67
 
! nfac             ! e  ! <-- ! nombre de faces internes                       !
68
 
! nfabor           ! e  ! <-- ! nombre de faces de bord                        !
69
 
! nfml             ! e  ! <-- ! nombre de familles d entites                   !
70
 
! nprfml           ! e  ! <-- ! nombre de proprietese des familles             !
71
 
! nnod             ! e  ! <-- ! nombre de sommets                              !
72
 
! lndfac           ! e  ! <-- ! longueur du tableau nodfac (optionnel          !
73
 
! lndfbr           ! e  ! <-- ! longueur du tableau nodfbr (optionnel          !
74
 
! ncelbr           ! e  ! <-- ! nombre d'elements ayant au moins une           !
75
 
!                  !    !     ! face de bord                                   !
76
48
! nvar             ! e  ! <-- ! nombre total de variables                      !
77
49
! nscal            ! e  ! <-- ! nombre total de scalaires                      !
78
 
! nphas            ! e  ! <-- ! nombre de phases                               !
79
50
! ncelps           ! e  ! <-- ! nombre de cellules du maillage post            !
80
51
! nfacps           ! e  ! <-- ! nombre de faces interieur post                 !
81
52
! nfbrps           ! e  ! <-- ! nombre de faces de bord post                   !
82
 
! nideve nrdeve    ! e  ! <-- ! longueur de idevel rdevel                      !
83
 
! nituse nrtuse    ! e  ! <-- ! longueur de ituser rtuser                      !
84
 
! ifacel           ! te ! <-- ! elements voisins d'une face interne            !
85
 
! (2, nfac)        !    !     !                                                !
86
 
! ifabor           ! te ! <-- ! element  voisin  d'une face de bord            !
87
 
! (nfabor)         !    !     !                                                !
88
 
! ifmfbr           ! te ! <-- ! numero de famille d'une face de bord           !
89
 
! (nfabor)         !    !     !                                                !
90
 
! ifmcel           ! te ! <-- ! numero de famille d'une cellule                !
91
 
! (ncelet)         !    !     !                                                !
92
 
! iprfml           ! te ! <-- ! proprietes d'une famille                       !
93
 
! nfml  ,nprfml    !    !     !                                                !
94
 
! ipnfac           ! te ! <-- ! position du premier noeud de chaque            !
95
 
!   (lndfac)       !    !     !  face interne dans nodfac (optionnel)          !
96
 
! nodfac           ! te ! <-- ! connectivite faces internes/noeuds             !
97
 
!   (nfac+1)       !    !     !  (optionnel)                                   !
98
 
! ipnfbr           ! te ! <-- ! position du premier noeud de chaque            !
99
 
!   (lndfbr)       !    !     !  face de bord dans nodfbr (optionnel)          !
100
 
! nodfbr           ! te ! <-- ! connectivite faces de bord/noeuds              !
101
 
!   (nfabor+1)     !    !     !  (optionnel)                                   !
102
53
! lstcel(ncelps    ! te ! <-- ! liste des cellules du maillage post            !
103
54
! lstfac(nfacps    ! te ! <-- ! liste des faces interieures post               !
104
55
! lstfbr(nfbrps    ! te ! <-- ! liste des faces de bord post                   !
105
 
! idevel(nideve    ! te ! <-- ! tab entier complementaire developemt           !
106
 
! ituser(nituse    ! te ! <-- ! tab entier complementaire utilisateur          !
107
 
! ia(*)            ! tr ! --- ! macro tableau entier                           !
108
 
! xyzcen           ! tr ! <-- ! point associes aux volumes de control          !
109
 
! (ndim,ncelet     !    !     !                                                !
110
 
! surfac           ! tr ! <-- ! vecteur surface des faces internes             !
111
 
! (ndim,nfac)      !    !     !                                                !
112
 
! surfbo           ! tr ! <-- ! vecteur surface des faces de bord              !
113
 
! (ndim,nfabor)    !    !     !                                                !
114
 
! cdgfac           ! tr ! <-- ! centre de gravite des faces internes           !
115
 
! (ndim,nfac)      !    !     !                                                !
116
 
! cdgfbo           ! tr ! <-- ! centre de gravite des faces de bord            !
117
 
! (ndim,nfabor)    !    !     !                                                !
118
 
! xyznod           ! tr ! <-- ! coordonnes des noeuds (optionnel)              !
119
 
! (ndim,nnod)      !    !     !                                                !
120
 
! volume           ! tr ! <-- ! volume d'un des ncelet elements                !
121
 
! (ncelet          !    !     !                                                !
122
56
! dt(ncelet)       ! tr ! <-- ! pas de temps                                   !
123
57
! rtp, rtpa        ! tr ! <-- ! variables de calcul au centre des              !
124
58
! (ncelet,*)       !    !     !    cellules (instant courant ou prec)          !
133
67
! tracel(*)        ! tr ! <-- ! tab reel valeurs cellules post                 !
134
68
! trafac(*)        ! tr ! <-- ! tab reel valeurs faces int. post               !
135
69
! trafbr(*)        ! tr ! <-- ! tab reel valeurs faces bord post               !
136
 
! w1-w2            ! tr ! --- ! tab reel pour calcul gradient                  !
137
 
! (ncelet,3)       !    !     !                                                !
138
 
! rdevel(nrdeve    ! tr ! <-- ! tab reel complementaire developemt             !
139
 
! rtuser(nrtuse    ! tr ! <-- ! tab reel complementaire utilisateur            !
140
 
! ra(*)            ! tr ! --- ! macro tableau reel                             !
141
70
!__________________!____!_____!________________________________________________!
142
71
 
143
72
!__________________!____!_____!________________________________________________!
148
77
!            --- tableau de travail
149
78
!===============================================================================
150
79
 
 
80
!===============================================================================
 
81
! Module files
 
82
!===============================================================================
 
83
 
 
84
use paramx
 
85
use dimens, only: ndimfb
 
86
use pointe
 
87
use numvar
 
88
use optcal
 
89
use cstphy
 
90
use cstnum
 
91
use entsor
 
92
use parall
 
93
use period
 
94
use ppppar
 
95
use ppthch
 
96
use ppincl
 
97
use elincl
 
98
use mesh
 
99
 
 
100
!===============================================================================
 
101
 
151
102
implicit none
152
103
 
153
 
!===============================================================================
154
 
!    Common blocks
155
 
!===============================================================================
156
 
 
157
 
include "dimfbr.h"
158
 
include "paramx.h"
159
 
include "pointe.h"
160
 
include "numvar.h"
161
 
include "optcal.h"
162
 
include "cstphy.h"
163
 
include "cstnum.h"
164
 
include "entsor.h"
165
 
include "parall.h"
166
 
include "period.h"
167
 
include "ppppar.h"
168
 
include "ppthch.h"
169
 
include "ppincl.h"
170
 
include "elincl.h"
171
 
 
172
 
!===============================================================================
173
 
 
174
104
! Arguments
175
105
 
176
 
integer          idbia0 , idbra0
177
106
integer          nummai
178
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
179
 
integer          nfml   , nprfml
180
 
integer          nnod   , lndfac , lndfbr , ncelbr
181
 
integer          nvar   , nscal  , nphas
 
107
integer          nvar   , nscal
182
108
integer          ncelps , nfacps , nfbrps
183
 
integer          nideve , nrdeve , nituse , nrtuse
184
109
integer          idimt
185
110
 
186
 
integer          ifacel(2,nfac) , ifabor(nfabor)
187
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
188
 
integer          iprfml(nfml,nprfml)
189
 
integer          ipnfac(nfac+1), nodfac(lndfac)
190
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr)
191
111
integer          lstcel(ncelps), lstfac(nfacps), lstfbr(nfbrps)
192
 
integer          idevel(nideve), ituser(nituse), ia(*)
193
112
 
194
 
double precision xyzcen(ndim,ncelet)
195
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
196
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
197
 
double precision xyznod(ndim,nnod), volume(ncelet)
198
113
double precision dt(ncelet), rtp(ncelet,*), rtpa(ncelet,*)
199
114
double precision propce(ncelet,*)
200
115
double precision propfa(nfac,*), propfb(ndimfb,*)
201
116
double precision coefa(ndimfb,*), coefb(ndimfb,*)
202
117
double precision tracel(ncelps*3)
203
118
double precision trafac(nfacps*3), trafbr(nfbrps*3)
204
 
double precision w1(ncelet,3), w2(ncelet,3)
205
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
206
119
 
207
120
! Local variables
208
121
 
209
122
character*32     namevr
210
 
integer          idebia, idebra, iel   , iloc
 
123
integer          iel   , iloc
211
124
integer          ivar  , ivar0 , inc   , iccocg
212
 
integer          iphydp, nswrgp, imligp, iwarnp, iclimv
 
125
integer          nswrgp, imligp, iwarnp, iclimv
213
126
integer          ipcsii
214
127
integer          ientla, ivarpr
215
128
double precision epsrgp, climgp, extrap
216
129
double precision rbid(1)
217
130
 
 
131
double precision, allocatable, dimension(:,:) :: grad
 
132
 
218
133
!===============================================================================
219
134
!===============================================================================
220
135
! 0.  PAR DEFAUT, ON CONSIDERE QUE LE SOUS PROGRAMME CI-DESSOUS CONVIENT
227
142
!       IL PEUT LES AJOUTER A LA FIN, VOIR LA DOCUMENTATION DE USEEVO
228
143
!===============================================================================
229
144
 
230
 
 
231
 
idebia = idbia0
232
 
idebra = idbra0
233
 
 
234
145
if(nummai.eq.-1) then
235
146
 
 
147
  ! Allocate work arrays
 
148
  allocate(grad(ncelet,3))
 
149
 
236
150
!===============================================================================
237
151
! 1.   Graident of the real potential
238
152
!===============================================================================
252
166
  climgp = climgr(ivar)
253
167
  extrap = extrag(ivar)
254
168
  ivar0 = 0
255
 
  iphydp = 0
256
169
!
257
170
  call grdcel                                                     &
258
171
  !==========
259
 
 ( idebia , idebra ,                                              &
260
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
261
 
   nnod   , lndfac , lndfbr , ncelbr , nphas  ,                   &
262
 
   nideve , nrdeve , nituse , nrtuse ,                            &
263
 
   ivar0  , imrgra , inc    , iccocg , nswrgp , imligp , iphydp , &
 
172
 ( ivar0  , imrgra , inc    , iccocg , nswrgp , imligp ,          &
264
173
   iwarnp , nfecra , epsrgp , climgp , extrap ,                   &
265
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
266
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
267
 
   idevel , ituser , ia     ,                                     &
268
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
269
 
   ra     , ra     , ra     ,                                     &
270
174
   rtp(1,ivar), coefa(1,iclimv) , coefb(1,iclimv)  ,              &
271
175
!       POTR
272
 
   w1(1,1) , w1(1,2) , w1(1,3) ,                                  &
273
 
!       d POTR /dx   d POTR /dy   d POTR /dz
274
 
   w2(1,1) , w2(1,2) , w2(1,3) ,                                  &
275
 
   rdevel , rtuser , ra     )
 
176
   grad   )
276
177
 
277
178
!
278
179
  ientla = 0
280
181
 
281
182
  call psteva(nummai, namevr, idimt, ientla, ivarpr,              &
282
183
  !==========
283
 
              ntcabs, ttcabs, w1, rbid, rbid)
 
184
              ntcabs, ttcabs, grad, rbid, rbid)
284
185
 
285
186
!===============================================================================
286
187
! 2.   For Joule Heating by direct conduction :
305
206
    extrap = extrag(ivar)
306
207
!
307
208
    ivar0 = 0
308
 
    iphydp = 0
309
209
!
310
210
    call grdcel                                                   &
311
211
    !==========
312
 
 ( idebia , idebra ,                                              &
313
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
314
 
   nnod   , lndfac , lndfbr , ncelbr , nphas  ,                   &
315
 
   nideve , nrdeve , nituse , nrtuse ,                            &
316
 
   ivar0  , imrgra , inc    , iccocg , nswrgp , imligp , iphydp , &
 
212
 ( ivar0  , imrgra , inc    , iccocg , nswrgp , imligp ,          &
317
213
   iwarnp , nfecra , epsrgp , climgp , extrap ,                   &
318
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
319
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
320
 
   idevel , ituser , ia     ,                                     &
321
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
322
 
   ra     , ra     , ra     ,                                     &
323
214
   rtp(1,ivar), coefa(1,iclimv) , coefb(1,iclimv)  ,              &
324
215
!       POTI
325
 
   w1(1,1) , w1(1,2) , w1(1,3) ,                                  &
326
 
!       d POTI /dx   d POTI /dy   d POTI /dz
327
 
   w2(1,1) , w2(1,2) , w2(1,3) ,                                  &
328
 
   rdevel , rtuser , ra     )
 
216
   grad   )
329
217
 
330
218
!
331
219
    ientla = 0
333
221
 
334
222
    call psteva(nummai, namevr, idimt, ientla, ivarpr,            &
335
223
    !==========
336
 
                ntcabs, ttcabs, w1, rbid, rbid)
 
224
                ntcabs, ttcabs, grad, rbid, rbid)
337
225
 
338
226
  endif
339
227
 
363
251
    extrap = extrag(ivar)
364
252
!
365
253
    ivar0 = 0
366
 
    iphydp = 0
367
254
 
368
255
    call grdcel                                                   &
369
256
    !==========
370
 
 ( idebia , idebra ,                                              &
371
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
372
 
   nnod   , lndfac , lndfbr , ncelbr , nphas  ,                   &
373
 
   nideve , nrdeve , nituse , nrtuse ,                            &
374
 
   ivar0  , imrgra , inc    , iccocg , nswrgp , imligp , iphydp , &
 
257
 ( ivar0  , imrgra , inc    , iccocg , nswrgp , imligp ,          &
375
258
   iwarnp , nfecra , epsrgp , climgp , extrap ,                   &
376
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
377
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
378
 
   idevel , ituser , ia     ,                                     &
379
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
380
 
   ra     , ra     , ra     ,                                     &
381
259
   rtp(1,ivar), coefa(1,iclimv) , coefb(1,iclimv)  ,              &
382
260
!       POTI
383
 
   w1(1,1) , w1(1,2) , w1(1,3) ,                                  &
384
 
!       d POTI /dx   d POTI /dy   d POTI /dz
385
 
   w2(1,1) , w2(1,2) , w2(1,3) ,                                  &
386
 
   rdevel , rtuser , ra     )
 
261
   grad   )
387
262
 
388
263
    do iloc = 1, ncelps
389
264
      iel = lstcel(iloc)
390
 
      tracel(iloc)          = -propce(iel,ipcsii)*w1(iel,1)
391
 
      tracel(iloc+ncelps)   = -propce(iel,ipcsii)*w1(iel,2)
392
 
      tracel(iloc+2*ncelps) = -propce(iel,ipcsii)*w1(iel,3)
 
265
      tracel(iloc)          = -propce(iel,ipcsii)*grad(iel,1)
 
266
      tracel(iloc+ncelps)   = -propce(iel,ipcsii)*grad(iel,2)
 
267
      tracel(iloc+2*ncelps) = -propce(iel,ipcsii)*grad(iel,3)
393
268
    enddo
394
269
!
395
270
    ientla = 0
425
300
    extrap = extrag(ivar)
426
301
!
427
302
    ivar0 = 0
428
 
    iphydp = 0
429
303
!
430
304
    call grdcel                                                   &
431
305
    !==========
432
 
 ( idebia , idebra ,                                              &
433
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
434
 
   nnod   , lndfac , lndfbr , ncelbr , nphas  ,                   &
435
 
   nideve , nrdeve , nituse , nrtuse ,                            &
436
 
   ivar0  , imrgra , inc    , iccocg , nswrgp , imligp , iphydp , &
 
306
 ( ivar0  , imrgra , inc    , iccocg , nswrgp , imligp ,          &
437
307
   iwarnp , nfecra , epsrgp , climgp , extrap ,                   &
438
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
439
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
440
 
   idevel , ituser , ia     ,                                     &
441
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
442
 
   ra     , ra     , ra     ,                                     &
443
308
   rtp(1,ivar), coefa(1,iclimv) , coefb(1,iclimv)  ,              &
444
 
   w1(1,1) , w1(1,2) , w1(1,3) ,                                  &
445
 
!       d Ax /dx   d Ax /dy   d Ax /dz
446
 
   w2(1,1) , w2(1,2) , w2(1,3) ,                                  &
447
 
   rdevel , rtuser , ra     )
 
309
   grad   )
448
310
 
449
311
!       B = rot A ( B = curl A)
450
312
 
451
313
    do iloc = 1, ncelps
452
314
      iel = lstcel(iloc)
453
315
      tracel(iloc)          =  zero
454
 
      tracel(iloc+ncelps)   =  w1(iel,3)
455
 
      tracel(iloc+2*ncelps) = -w1(iel,2)
 
316
      tracel(iloc+ncelps)   =  grad(iel,3)
 
317
      tracel(iloc+2*ncelps) = -grad(iel,2)
456
318
    enddo
457
319
 
458
320
!    Ay component
470
332
    extrap = extrag(ivar)
471
333
!
472
334
    ivar0 = 0
473
 
    iphydp = 0
474
335
!
475
336
    call grdcel                                                   &
476
337
    !==========
477
 
  ( idbia0 , idbra0 ,                                             &
478
 
    ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml ,&
479
 
    nnod   , lndfac , lndfbr , ncelbr , nphas  ,                  &
480
 
    nideve , nrdeve , nituse , nrtuse ,                           &
481
 
    ivar0  , imrgra , inc    , iccocg , nswrgp , imligp , iphydp ,&
 
338
  ( ivar0  , imrgra , inc    , iccocg , nswrgp , imligp ,         &
482
339
    iwarnp , nfecra , epsrgp , climgp , extrap ,                  &
483
 
    ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                  &
484
 
    ipnfac , nodfac , ipnfbr , nodfbr ,                           &
485
 
    idevel , ituser , ia     ,                                    &
486
 
    xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume ,&
487
 
    ra     , ra     , ra     ,                                    &
488
340
    rtp(1,ivar), coefa(1,iclimv) , coefb(1,iclimv) ,              &
489
 
    w1(1,1) , w1(1,2) , w1(1,3) ,                                 &
490
 
!       d Ay /dx   d Ay /dy   d Ay /dz
491
 
    w2(1,1) , w2(1,2) , w2(1,3) ,                                 &
492
 
    rdevel , rtuser , ra     )
 
341
    grad   )
493
342
 
494
343
!       B = rot A (B = curl A)
495
344
 
496
345
    do iloc = 1, ncelps
497
346
      iel = lstcel(iloc)
498
 
      tracel(iloc)          = tracel(iloc)          - w1(iel,3)
 
347
      tracel(iloc)          = tracel(iloc)          - grad(iel,3)
499
348
      tracel(iloc+ncelps)   = tracel(iloc + ncelps) + zero
500
 
      tracel(iloc+2*ncelps) = tracel(iloc+2*ncelps) + w1(iel,1)
 
349
      tracel(iloc+2*ncelps) = tracel(iloc+2*ncelps) + grad(iel,1)
501
350
    enddo
502
351
 
503
352
!    Az component
515
364
    extrap = extrag(ivar)
516
365
!
517
366
    ivar0 = 0
518
 
   iphydp = 0
519
367
!
520
368
    call grdcel                                                   &
521
369
    !==========
522
 
  ( idbia0 , idbra0 ,                                             &
523
 
    ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml ,&
524
 
    nnod   , lndfac , lndfbr , ncelbr , nphas  ,                  &
525
 
    nideve , nrdeve , nituse , nrtuse ,                           &
526
 
    ivar0  , imrgra , inc    , iccocg , nswrgp , imligp , iphydp ,&
 
370
  ( ivar0  , imrgra , inc    , iccocg , nswrgp , imligp ,         &
527
371
    iwarnp , nfecra , epsrgp , climgp , extrap ,                  &
528
 
    ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                  &
529
 
    ipnfac , nodfac , ipnfbr , nodfbr ,                           &
530
 
    idevel , ituser , ia     ,                                    &
531
 
    xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume ,&
532
 
    ra     , ra     , ra     ,                                    &
533
372
    rtp(1,ivar), coefa(1,iclimv) , coefb(1,iclimv) ,              &
534
 
    w1(1,1) , w1(1,2) , w1(1,3) ,                                 &
535
 
!       d Az /dx   d Az /dy   d Az /dz
536
 
    w2(1,1) , w2(1,2) , w2(1,3) ,                                 &
537
 
    rdevel , rtuser , ra     )
 
373
    grad   )
538
374
 
539
375
!       B = rot A (B = curl A)
540
376
 
541
377
    do iloc = 1, ncelps
542
378
      iel = lstcel(iloc)
543
 
      tracel(iloc)          = tracel(iloc)          + w1(iel,2)
544
 
      tracel(iloc+ncelps)   = tracel(iloc+ncelps)   - w1(iel,1)
 
379
      tracel(iloc)          = tracel(iloc)          + grad(iel,2)
 
380
      tracel(iloc+ncelps)   = tracel(iloc+ncelps)   - grad(iel,1)
545
381
      tracel(iloc+2*ncelps) = tracel(iloc+2*ncelps) + zero
546
382
    enddo
547
383
!
623
459
 
624
460
  endif
625
461
 
 
462
  ! Free memory
 
463
  deallocate(grad)
 
464
 
626
465
endif
627
466
 
628
467
return