← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/lagr/lagpoi.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/lagr/lagpoi.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 lagpoi &
29
24
!================
30
25
 
31
 
 ( idbia0 , idbra0 ,                                              &
32
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
33
 
   nnod   , lndnod , lndfac ,lndfbr , ncelbr ,                    &
34
 
   nvar   , nscal  , nphas  ,                                     &
 
26
 ( lndnod ,                                                       &
 
27
   nvar   , nscal  ,                                              &
35
28
   nbpmax , nvp    , nvp1   , nvep   , nivep  ,                   &
36
29
   ntersl , nvlsta , nvisbr ,                                     &
37
 
   nideve , nrdeve , nituse , nrtuse ,                            &
38
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
39
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
40
30
   icocel , itycel , ifrlag , itepa  ,                            &
41
 
   idevel , ituser , ia     ,                                     &
42
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
43
31
   dt     , rtpa   , rtp    , propce , propfa , propfb ,          &
44
32
   coefa  , coefb  ,                                              &
45
 
   ettp   , tepa   , statis ,                                     &
46
 
   w1     , w2     , w3     ,                                     &
47
 
   rdevel , rtuser , ra     )
 
33
   ettp   , tepa   , statis )
48
34
 
49
35
!===============================================================================
50
36
! FONCTION :
63
49
!__________________.____._____.________________________________________________.
64
50
! name             !type!mode ! role                                           !
65
51
!__________________!____!_____!________________________________________________!
66
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
67
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
68
 
! ndim             ! i  ! <-- ! spatial dimension                              !
69
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
70
 
! ncel             ! i  ! <-- ! number of cells                                !
71
 
! nfac             ! i  ! <-- ! number of interior faces                       !
72
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
73
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
74
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
75
 
! nnod             ! i  ! <-- ! number of vertices                             !
76
52
! lndnod           ! e  ! <-- ! dim. connectivite cellules->faces              !
77
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
78
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
79
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
80
53
! nvar             ! i  ! <-- ! total number of variables                      !
81
54
! nscal            ! i  ! <-- ! total number of scalars                        !
82
 
! nphas            ! i  ! <-- ! number of phases                               !
83
55
! nbpmax           ! e  ! <-- ! nombre max de particulies autorise             !
84
56
! nvp              ! e  ! <-- ! nombre de variables particulaires              !
85
57
! nvp1             ! e  ! <-- ! nvp sans position, vfluide, vpart              !
88
60
! ntersl           ! e  ! <-- ! nbr termes sources de couplage retour          !
89
61
! nvlsta           ! e  ! <-- ! nombre de var statistiques lagrangien          !
90
62
! nvisbr           ! e  ! <-- ! nombre de statistiques aux frontieres          !
91
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
92
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
93
 
! ifacel(2, nfac)  ! ia ! <-- ! interior faces -> cells connectivity           !
94
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
95
 
! ifmfbr(nfabor)   ! ia ! <-- ! boundary face family numbers                   !
96
 
! ifmcel(ncelet)   ! ia ! <-- ! cell family numbers                            !
97
 
! iprfml           ! te ! <-- ! proprietes d'une famille                       !
98
 
!  (nfml,nprfml    !    !     !                                                !
99
 
! ipnfac           ! te ! <-- ! position du premier noeud de chaque            !
100
 
!   (lndfac)       !    !     !  face interne dans nodfac                      !
101
 
! nodfac           ! te ! <-- ! connectivite faces internes/noeuds             !
102
 
!   (nfac+1)       !    !     !                                                !
103
 
! ipnfbr           ! te ! <-- ! position du premier noeud de chaque            !
104
 
!   (lndfbr)       !    !     !  face de bord dans nodfbr                      !
105
 
! nodfbr           ! te ! <-- ! connectivite faces de bord/noeuds              !
106
 
!   (nfabor+1)     !    !     !                                                !
107
63
! icocel           ! te ! --> ! connectivite cellules -> faces                 !
108
64
! (lndnod)         !    !     !    face de bord si numero negatif              !
109
65
! itycel           ! te ! --> ! connectivite cellules -> faces                 !
112
68
! (nfabor)         !    !     !  pour le module lagrangien                     !
113
69
! itepa            ! te ! --> ! info particulaires (entiers)                   !
114
70
! (nbpmax,nivep    !    !     !   (cellule de la particule,...)                !
115
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
116
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
117
 
! ia(*)            ! ia ! --- ! main integer work array                        !
118
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
119
 
!  (ndim, ncelet)  !    !     !                                                !
120
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
121
 
!  (ndim, nfac)    !    !     !                                                !
122
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
123
 
!  (ndim, nfabor)  !    !     !                                                !
124
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
125
 
!  (ndim, nfac)    !    !     !                                                !
126
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
127
 
!  (ndim, nfabor)  !    !     !                                                !
128
 
! xyznod           ! tr ! <-- ! coordonnes des noeuds                          !
129
 
! (ndim,nnod)      !    !     !                                                !
130
 
! volume(ncelet    ! tr ! <-- ! volume d'un des ncelet elements                !
131
71
! dt(ncelet)       ! ra ! <-- ! time step (per cell)                           !
132
72
! rtp, rtpa        ! ra ! <-- ! calculated variables at cell centers           !
133
73
!  (ncelet, *)     !    !     !  (at current and previous time steps)          !
142
82
! (nbpmax,nvep)    !    !     !   (poids statistiques,...)                     !
143
83
! statis           ! tr ! <-- ! moyennes statistiques                          !
144
84
!(ncelet,nvlsta    !    !     !                                                !
145
 
! w1...w3(ncel)    ! tr ! --- ! tableau de travail                             !
146
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
147
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
148
 
! ra(*)            ! ra ! --- ! main real work array                           !
149
85
!__________________!____!_____!________________________________________________!
150
86
 
151
87
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
152
88
!            L (LOGIQUE)   .. ET TYPES COMPOSES (EX : TR TABLEAU REEL)
153
89
!     MODE : <-- donnee, --> resultat, <-> Donnee modifiee
154
90
!            --- tableau de travail
 
91
!===============================================================================
 
92
 
 
93
!===============================================================================
 
94
! Module files
 
95
!===============================================================================
 
96
 
 
97
use paramx
 
98
use numvar
 
99
use optcal
 
100
use entsor
 
101
use cstphy
 
102
use cstnum
 
103
use pointe
 
104
use parall
 
105
use period
 
106
use lagpar
 
107
use lagran
 
108
use mesh
155
109
 
156
110
!===============================================================================
157
111
 
158
112
implicit none
159
113
 
160
 
!===============================================================================
161
 
! Common blocks
162
 
!===============================================================================
163
 
 
164
 
include "paramx.h"
165
 
include "numvar.h"
166
 
include "optcal.h"
167
 
include "entsor.h"
168
 
include "cstphy.h"
169
 
include "cstnum.h"
170
 
include "pointe.h"
171
 
include "period.h"
172
 
include "parall.h"
173
 
include "lagpar.h"
174
 
include "lagran.h"
175
 
 
176
 
!===============================================================================
177
 
 
178
114
! Arguments
179
115
 
180
 
integer          idbia0 , idbra0
181
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
182
 
integer          nfml   , nprfml
183
 
integer          nnod   , lndnod , lndfac , lndfbr , ncelbr
184
 
integer          nvar   , nscal  , nphas
 
116
integer          lndnod
 
117
integer          nvar   , nscal
185
118
integer          nbpmax , nvp    , nvp1   , nvep  , nivep
186
119
integer          ntersl , nvlsta , nvisbr
187
 
integer          nideve , nrdeve , nituse , nrtuse
188
 
integer          ifacel(2,nfac) , ifabor(nfabor)
189
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
190
 
integer          iprfml(nfml,nprfml)
191
 
integer          ipnfac(nfac+1) , nodfac(lndfac)
192
 
integer          ipnfbr(nfabor+1) , nodfbr(lndfbr)
 
120
 
193
121
integer          icocel(lndnod) , itycel(ncelet+1)
194
122
integer          ifrlag(nfabor) ,  itepa(nbpmax,nivep)
195
 
integer          idevel(nideve), ituser(nituse)
196
 
integer          ia(*)
197
123
 
198
 
double precision xyzcen(ndim,ncelet)
199
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
200
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
201
 
double precision xyznod(ndim,nnod), volume(ncelet)
202
124
double precision dt(ncelet), rtp(ncelet,*), rtpa(ncelet,*)
203
125
double precision propce(ncelet,*)
204
126
double precision propfa(nfac,*), propfb(nfabor,*)
205
127
double precision coefa(nfabor,*) , coefb(nfabor,*)
206
128
double precision ettp(nbpmax,nvp) , tepa(nbpmax,nvep)
207
129
double precision statis(ncelet,nvlsta)
208
 
double precision w1(ncelet) ,  w2(ncelet) ,  w3(ncelet)
209
 
double precision rdevel(nrdeve), rtuser(nrtuse)
210
 
double precision ra(*)
211
130
 
212
131
! Local variables
213
132
 
214
 
integer          idebia, idebra
215
 
integer          ifinia, ifinra
216
133
integer          npt , iel , ifac
217
 
integer          iphila , iphil
218
 
integer          iw1   , iw2   , iw3   , iw4 , iw5
219
 
integer          iw6   , iw7   , iw8   , iw9
220
 
integer          idtr   , ifmala , ifmalb
221
 
integer          iviscf , iviscb , idam   , ixam
222
 
integer          idrtp  , ismbr  , irovsd
223
 
integer          icoefap , icoefbp
224
134
integer          ivar0
225
135
integer          inc, iccocg
226
136
integer          nswrgp , imligp , iwarnp
227
 
integer          idimte , itenso , iphydp
 
137
 
228
138
double precision epsrgp , climgp , extrap
229
139
 
 
140
double precision, allocatable, dimension(:,:) :: grad
 
141
double precision, allocatable, dimension(:) :: phil
 
142
double precision, allocatable, dimension(:) :: coefap, coefbp
 
143
 
230
144
!===============================================================================
231
145
! 0.  GESTION MEMOIRE
232
146
!===============================================================================
233
147
 
234
 
idebia = idbia0
235
 
idebra = idbra0
236
148
 
237
149
!===============================================================================
238
150
! 1.  INITIALISATIONS
239
151
!===============================================================================
240
152
 
241
 
idtr   = idebra
242
 
iviscf = idtr   + ncelet
243
 
iviscb = iviscf + nfac
244
 
idam   = iviscb + nfabor
245
 
ixam   = idam   + ncelet
246
 
idrtp  = ixam   + nfac*2
247
 
ismbr  = idrtp  + ncelet
248
 
irovsd = ismbr  + ncelet
249
 
ifmala = irovsd + ncelet
250
 
ifmalb = ifmala + nfac
251
 
 
252
 
iphila  = ifmalb + nfabor
253
 
iphil   = iphila  + ncelet
254
 
iw1    = iphil   + ncelet
255
 
iw2    = iw1    + ncelet
256
 
iw3    = iw2    + ncelet
257
 
iw4    = iw3    + ncelet
258
 
iw5    = iw4    + ncelet
259
 
iw6    = iw5    + ncelet
260
 
iw7    = iw6    + ncelet
261
 
iw8    = iw7    + ncelet
262
 
iw9    = iw8    + ncelet
263
 
ifinra = iw9    + ncelet
264
 
CALL RASIZE('LAGPOI',IFINRA)
265
 
!     ==========
 
153
! Allocate a temporary array
 
154
allocate(phil(ncelet))
266
155
 
267
156
do iel=1,ncel
268
157
  if ( statis(iel,ilpd) .gt. seuil ) then
269
 
    statis(iel,ilvx) = statis(iel,ilvx)                           &
270
 
                      /statis(iel,ilpd)
271
 
    statis(iel,ilvy) = statis(iel,ilvy)                           &
272
 
                      /statis(iel,ilpd)
273
 
    statis(iel,ilvz) = statis(iel,ilvz)                           &
274
 
                      /statis(iel,ilpd)
275
 
    statis(iel,ilfv) = statis(iel,ilfv)                           &
276
 
                      /( dble(npst) * volume(iel) )
 
158
    statis(iel,ilvx) = statis(iel,ilvx) / statis(iel,ilpd)
 
159
    statis(iel,ilvy) = statis(iel,ilvy) / statis(iel,ilpd)
 
160
    statis(iel,ilvz) = statis(iel,ilvz) / statis(iel,ilpd)
 
161
    statis(iel,ilfv) = statis(iel,ilfv) / ( dble(npst) * volume(iel) )
277
162
  else
278
163
    statis(iel,ilvx) = 0.d0
279
164
    statis(iel,ilvy) = 0.d0
284
169
 
285
170
call lageqp                                                       &
286
171
!==========
287
 
 ( ifinia , ifinra ,                                              &
288
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
289
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
290
 
   nvar   , nscal  , nphas  ,                                     &
291
 
   nideve , nrdeve , nituse , nrtuse ,                            &
292
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
293
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
294
 
   idevel , ituser , ia     ,                                     &
295
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
 
172
 ( nvar   , nscal  ,                                              &
296
173
   dt     , propce , propfa , propfb ,                            &
297
 
   ra(iviscf) , ra(iviscb) ,                                      &
298
 
   ra(idam) , ra(ixam) ,                                          &
299
 
   ra(idrtp) , ra(ismbr) , ra(irovsd) ,                           &
300
 
   ra(ifmala) , ra(ifmalb) ,                                      &
301
 
   statis(1,ilvx) , statis(1,ilvy) , statis(1,ilvz) ,             &
302
 
   statis(1,ilfv) ,                                               &
303
 
   ra(iphila) , ra(iphil) ,                                       &
304
 
   w1     , w2     , w3     , ra(iw1) , ra(iw2) ,                 &
305
 
   ra(iw3) , ra(iw4) , ra(iw5) , ra(iw6) ,                        &
306
 
   ra(iw7) , ra(iw8) , ra(iw9) ,                                  &
307
 
   rdevel , rtuser ,                                              &
308
 
   ra     )
 
174
   statis(1,ilvx)  , statis(1,ilvy)  , statis(1,ilvz)  ,          &
 
175
   statis(1,ilfv)  ,                                              &
 
176
   phil   )
309
177
 
310
178
! Calcul du gradient du Correcteur PHI
311
179
! ====================================
312
180
 
313
 
 
314
 
!       On alloue localement 2 tableaux de NFABOR pour le calcul
315
 
!         de COEFA et COEFB de W1,W2,W3
316
 
 
317
 
icoefap = ifinra
318
 
icoefbp = icoefap + nfabor
319
 
ifinra  = icoefbp + nfabor
320
 
CALL RASIZE ('LAGEQP',IFINRA)
321
 
!==========
 
181
! Allocate temporary arrays
 
182
allocate(coefap(nfabor))
 
183
allocate(coefbp(nfabor))
322
184
 
323
185
do ifac = 1, nfabor
324
186
  iel = ifabor(ifac)
325
 
  ra(icoefap+ifac-1) = ra(iphil+iel-1)
326
 
  ra(icoefbp+ifac-1) = zero
 
187
  coefap(ifac) = phil(iel)
 
188
  coefbp(ifac) = zero
327
189
enddo
328
190
 
329
191
inc = 1
335
197
climgp = 1.5d0
336
198
extrap = 0.d0
337
199
 
 
200
! Allocate a work array
 
201
allocate(grad(ncelet,3))
338
202
 
339
203
! En periodique et parallele, echange avant calcul du gradient
340
 
 
341
 
!    Parallele
342
 
if(irangp.ge.0) then
343
 
  call parcom(ra(iphil))
344
 
  !==========
345
 
endif
346
 
 
347
 
!    Periodique
348
 
if(iperio.eq.1) then
349
 
  idimte = 0
350
 
  itenso = 0
351
 
  call percom                                                     &
352
 
  !==========
353
 
  ( idimte , itenso ,                                             &
354
 
    ra(iphil) , ra(iphil) , ra(iphil) ,                           &
355
 
    ra(iphil) , ra(iphil) , ra(iphil) ,                           &
356
 
    ra(iphil) , ra(iphil) , ra(iphil)  )
 
204
if (irangp.ge.0.or.iperio.eq.1) then
 
205
  call synsca(phil)
 
206
  !==========
357
207
endif
358
208
 
359
209
!  IVAR0 = 0 (indique pour la periodicite de rotation que la variable
360
210
!     n'est pas la vitesse ni Rij)
361
211
ivar0 = 0
362
212
 
363
 
!    Sans prise en compte de la pression hydrostatique
364
 
 
365
 
iphydp = 0
366
 
 
367
213
call grdcel                                                       &
368
214
!==========
369
 
 ( ifinia , ifinra ,                                              &
370
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
371
 
   nnod   , lndfac , lndfbr , ncelbr , nphas  ,                   &
372
 
   nideve , nrdeve , nituse , nrtuse ,                            &
373
 
   ivar0  , imrgra , inc    , iccocg , nswrgp , imligp , iphydp , &
 
215
 ( ivar0  , imrgra , inc    , iccocg , nswrgp , imligp ,          &
374
216
   iwarnp , nfecra , epsrgp , climgp , extrap ,                   &
375
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
376
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
377
 
   idevel , ituser , ia     ,                                     &
378
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
379
 
   ra(iphil) , ra(iphil) , ra(iphil)    ,                         &
380
 
   ra(iphil) , ra(icoefap) , ra(icoefbp) ,                        &
381
 
   w1       , w2    , w3 ,                                        &
382
 
   ra(iw1)  , ra(iw2) , ra(iw3) ,                                 &
383
 
   rdevel , rtuser , ra     )
 
217
   phil   , coefap , coefbp ,                                     &
 
218
   grad   )
 
219
 
 
220
! Free memory
 
221
deallocate(phil)
 
222
deallocate(coefap, coefbp)
384
223
 
385
224
! CORRECTION DES VITESSES MOYENNES ET RETOUR AU CUMUL
386
225
 
387
226
do iel = 1,ncel
388
227
  if ( statis(iel,ilpd) .gt. seuil ) then
389
 
    statis(iel,ilvx) = statis(iel,ilvx) - w1(iel)
390
 
    statis(iel,ilvy) = statis(iel,ilvy) - w2(iel)
391
 
    statis(iel,ilvz) = statis(iel,ilvz) - w3(iel)
 
228
    statis(iel,ilvx) = statis(iel,ilvx) - grad(iel,1)
 
229
    statis(iel,ilvy) = statis(iel,ilvy) - grad(iel,2)
 
230
    statis(iel,ilvz) = statis(iel,ilvz) - grad(iel,3)
392
231
  endif
393
232
enddo
394
233
 
397
236
    statis(iel,ilvx) = statis(iel,ilvx)*statis(iel,ilpd)
398
237
    statis(iel,ilvy) = statis(iel,ilvy)*statis(iel,ilpd)
399
238
    statis(iel,ilvz) = statis(iel,ilvz)*statis(iel,ilpd)
400
 
    statis(iel,ilfv) = statis(iel,ilfv)                           &
401
 
                      *( dble(npst) * volume(iel) )
 
239
    statis(iel,ilfv) = statis(iel,ilfv)*( dble(npst) * volume(iel) )
402
240
  endif
403
241
enddo
404
242
 
407
245
do npt = 1,nbpart
408
246
  if ( itepa(npt,jisor).gt.0 ) then
409
247
    iel = itepa(npt,jisor)
410
 
    ettp(npt,jup) = ettp(npt,jup) - w1(iel)
411
 
    ettp(npt,jvp) = ettp(npt,jvp) - w2(iel)
412
 
    ettp(npt,jwp) = ettp(npt,jwp) - w3(iel)
 
248
    ettp(npt,jup) = ettp(npt,jup) - grad(iel,1)
 
249
    ettp(npt,jvp) = ettp(npt,jvp) - grad(iel,2)
 
250
    ettp(npt,jwp) = ettp(npt,jwp) - grad(iel,3)
413
251
  endif
414
252
enddo
415
253
 
 
254
! Free memory
 
255
deallocate(grad)
 
256
 
416
257
!===============================================================================
417
258
 
418
259
!--------