← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/base/codits.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/codits.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 codits &
29
24
!================
30
25
 
31
 
 ( idbia0 , idbra0 ,                                              &
32
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
33
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
34
 
   nvar   , nscal  , nphas  ,                                     &
35
 
   nideve , nrdeve , nituse , nrtuse ,                            &
 
26
 ( nvar   , nscal  ,                                              &
36
27
   idtvar , ivar   , iconvp , idiffp , ireslp , ndircp , nitmap , &
37
28
   imrgra , nswrsp , nswrgp , imligp , ircflp ,                   &
38
29
   ischcp , isstpp , iescap ,                                     &
39
30
   imgrp  , ncymxp , nitmfp , ipp    , iwarnp ,                   &
40
31
   blencp , epsilp , epsrsp , epsrgp , climgp , extrap ,          &
41
32
   relaxp , thetap ,                                              &
42
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
43
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
44
 
   idevel , ituser , ia     ,                                     &
45
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
46
33
   pvara  , pvark  ,                                              &
47
34
   coefap , coefbp , cofafp , cofbfp , flumas , flumab ,          &
48
35
   viscfm , viscbm , viscfs , viscbs ,                            &
49
36
   rovsdt , smbrp  , pvar   ,                                     &
50
 
   dam    , xam    , dpvar  ,                                     &
51
 
   w1     , w2     , w3     , w4     , w5     ,                   &
52
 
   w6     , w7     , w8     , smbini ,                            &
53
 
   rdevel , rtuser , ra     )
 
37
   eswork )
54
38
 
55
39
!===============================================================================
56
40
! FONCTION :
107
91
!__________________.____._____.________________________________________________.
108
92
! name             !type!mode ! role                                           !
109
93
!__________________!____!_____!________________________________________________!
110
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
111
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
112
 
! ndim             ! i  ! <-- ! spatial dimension                              !
113
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
114
 
! ncel             ! i  ! <-- ! number of cells                                !
115
 
! nfac             ! i  ! <-- ! number of interior faces                       !
116
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
117
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
118
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
119
 
! nnod             ! i  ! <-- ! number of vertices                             !
120
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
121
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
122
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
123
94
! nvar             ! i  ! <-- ! total number of variables                      !
124
95
! nscal            ! i  ! <-- ! total number of scalars                        !
125
 
! nphas            ! i  ! <-- ! number of phases                               !
126
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
127
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
128
96
! idtvar           ! e  ! <-- ! indicateur du schema temporel                  !
129
97
! ivar             ! e  ! <-- ! variable traitee                               !
130
98
! iconvp           ! e  ! <-- ! indicateur = 1 convection, 0 sinon             !
168
136
!                  !    !     !   totalement centre en temps (mixage           !
169
137
!                  !    !     !   entre crank-nicolson et adams-               !
170
138
!                  !    !     !   bashforth)                                   !
171
 
! ifacel(2, nfac)  ! ia ! <-- ! interior faces -> cells connectivity           !
172
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
173
 
! ifmfbr(nfabor)   ! ia ! <-- ! boundary face family numbers                   !
174
 
! ifmcel(ncelet)   ! ia ! <-- ! cell family numbers                            !
175
 
! iprfml           ! ia ! <-- ! property numbers per family                    !
176
 
!  (nfml, nprfml)  !    !     !                                                !
177
 
! ipnfac(nfac+1)   ! ia ! <-- ! interior faces -> vertices index (optional)    !
178
 
! nodfac(lndfac)   ! ia ! <-- ! interior faces -> vertices list (optional)     !
179
 
! ipnfbr(nfabor+1) ! ia ! <-- ! boundary faces -> vertices index (optional)    !
180
 
! nodfbr(lndfbr)   ! ia ! <-- ! boundary faces -> vertices list (optional)     !
181
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
182
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
183
 
! ia(*)            ! ia ! --- ! main integer work array                        !
184
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
185
 
!  (ndim, ncelet)  !    !     !                                                !
186
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
187
 
!  (ndim, nfac)    !    !     !                                                !
188
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
189
 
!  (ndim, nfabor)  !    !     !                                                !
190
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
191
 
!  (ndim, nfac)    !    !     !                                                !
192
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
193
 
!  (ndim, nfabor)  !    !     !                                                !
194
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !
195
 
!  (ndim, nnod)    !    !     !                                                !
196
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !
197
139
! pvara(ncelet     ! tr ! <-- ! variable resolue (instant precedent)           !
198
140
! pvark(ncelet     ! tr ! <-- ! variable de la sous-iteration                  !
199
141
!                  !    !     !  precedente. pour un point fixe sur            !
215
157
! rovsdt(ncelet    ! tr ! <-- ! rho*volume/dt                                  !
216
158
! smbrp(ncelet     ! tr ! <-- ! bilan au second membre                         !
217
159
! pvar (ncelet     ! tr ! <-- ! variable resolue                               !
218
 
! dam(ncelet       ! tr ! --> ! tableau de travail pour matrice                !
219
 
!                  !    !     !  et resultat estimateur                        !
220
 
! xam(nfac,*)      ! tr ! --- ! tableau de travail pour matrice                !
221
 
! w1...8(ncelet    ! tr ! --- ! tableau de travail                             !
222
 
! smbini(ncelet    ! tr ! --- ! tableau de travail                             !
223
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
224
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
225
 
! ra(*)            ! ra ! --- ! main real work array                           !
 
160
! eswork(ncelet)   ! ra ! <-- ! prediction-stage error estimator (iescap > 0)  !
226
161
!__________________!____!_____!________________________________________________!
227
162
 
228
163
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
231
166
!            --- tableau de travail
232
167
!===============================================================================
233
168
 
 
169
!===============================================================================
 
170
! Module files
 
171
!===============================================================================
 
172
 
 
173
use paramx
 
174
use numvar
 
175
use cstnum
 
176
use entsor
 
177
use parall
 
178
use period
 
179
use mltgrd
 
180
use optcal, only: rlxp1
 
181
use mesh
 
182
 
 
183
!===============================================================================
 
184
 
234
185
implicit none
235
186
 
236
 
!===============================================================================
237
 
! Common blocks
238
 
!===============================================================================
239
 
 
240
 
include "paramx.h"
241
 
include "numvar.h"
242
 
include "cstnum.h"
243
 
include "entsor.h"
244
 
include "period.h"
245
 
include "parall.h"
246
 
include "mltgrd.h"
247
 
 
248
 
!===============================================================================
249
 
 
250
187
! Arguments
251
188
 
252
 
integer          idbia0 , idbra0
253
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
254
 
integer          nfml   , nprfml
255
 
integer          nnod   , lndfac , lndfbr , ncelbr
256
 
integer          nvar   , nscal  , nphas
257
 
integer          nideve , nrdeve , nituse , nrtuse
 
189
integer          nvar   , nscal
258
190
integer          idtvar , ivar   , iconvp , idiffp , ndircp
259
191
integer          nitmap
260
192
integer          imrgra , nswrsp , nswrgp , imligp , ircflp
264
196
double precision blencp , epsilp , epsrgp , climgp , extrap
265
197
double precision relaxp , thetap , epsrsp
266
198
 
267
 
integer          ifacel(2,nfac) , ifabor(nfabor)
268
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
269
 
integer          iprfml(nfml,nprfml)
270
 
integer          ipnfac(nfac+1), nodfac(lndfac)
271
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr)
272
 
integer          idevel(nideve), ituser(nituse)
273
 
integer          ia(*)
274
199
 
275
 
double precision xyzcen(ndim,ncelet)
276
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
277
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
278
 
double precision xyznod(ndim,nnod), volume(ncelet)
279
200
double precision pvara(ncelet), pvark(ncelet)
280
201
double precision coefap(nfabor), coefbp(nfabor)
281
202
double precision cofafp(nfabor), cofbfp(nfabor)
284
205
double precision viscfs(nfac), viscbs(nfabor)
285
206
double precision rovsdt(ncelet), smbrp(ncelet)
286
207
double precision pvar(ncelet)
287
 
double precision dam(ncelet), xam(nfac ,2)
288
 
double precision dpvar(ncelet)
289
 
double precision w1(ncelet), w2(ncelet), w3(ncelet), w4(ncelet)
290
 
double precision w5(ncelet), w6(ncelet), w7(ncelet), w8(ncelet)
291
 
double precision smbini(ncelet)
292
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
 
208
double precision eswork(ncelet)
293
209
 
294
210
! Local variables
295
211
 
296
212
character*80     chaine
297
 
character*8      cnom
 
213
character*16     cnom
298
214
integer          lchain
299
 
integer          idebia, idebra
300
215
integer          isym,ireslp,ireslq,ipol,isqrt
301
216
integer          inc,isweep,niterf,iccocg,iel,icycle,nswmod
302
 
integer          iphas,idimte,itenso,iinvpe, iinvpp
 
217
integer          idimte,itenso,iinvpe, iinvpp
303
218
integer          idtva0
304
219
integer          iagmax, nagmax, npstmg
 
220
integer          ibsize
 
221
 
305
222
double precision residu,rnorm
306
223
double precision thetex
307
224
 
 
225
double precision, allocatable, dimension(:) :: dam
 
226
double precision, allocatable, dimension(:,:) :: xam
 
227
double precision, allocatable, dimension(:) :: dpvar, smbini, w1
 
228
 
308
229
!===============================================================================
309
230
 
310
231
!===============================================================================
311
232
! 1.  INITIALISATIONS
312
233
!===============================================================================
313
234
 
314
 
idebia = idbia0
315
 
idebra = idbra0
 
235
! Allocate temporary arrays
 
236
allocate(dam(ncelet), xam(nfac,2))
 
237
allocate(dpvar(ncelet), smbini(ncelet))
 
238
 
316
239
 
317
240
! NOMS
318
241
chaine = nomvar(ipp)
319
 
cnom   = chaine(1:8)
 
242
cnom   = chaine(1:16)
320
243
 
321
244
! MATRICE A PRIORI SYMETRIQUE ( = 1)
322
245
isym  = 1
358
281
 
359
282
  iinvpe = 1
360
283
 
361
 
  do iphas = 1, nphas
362
 
    if(ivar.eq.iu(iphas).or.ivar.eq.iv(iphas).or.                 &
363
 
                            ivar.eq.iw(iphas).or.                 &
364
 
       ivar.eq.ir11(iphas).or.ivar.eq.ir12(iphas).or.             &
365
 
       ivar.eq.ir13(iphas).or.ivar.eq.ir22(iphas).or.             &
366
 
       ivar.eq.ir23(iphas).or.ivar.eq.ir33(iphas)) then
367
 
 
368
 
!    Pour la vitesse et les tensions de Reynolds, et les tpucou
369
 
!      seules seront echangees les informations sur les faces periodiques
370
 
!      de translation dans percom ; on ne touche pas aux informations
371
 
!      relatives aux faces de periodicite de rotation.
372
 
      idimte = 0
373
 
      itenso = 1
374
 
 
375
 
!      Lors de la resolution par increments, on echangera egalement les
376
 
!      informations relatives aux faces de periodicite de translation.
377
 
!      Pour les faces de periodicite de rotation, l'increment sera
378
 
!      annule dans percom (iinvpe=2).
379
 
      iinvpe = 2
380
 
 
381
 
    endif
382
 
  enddo
 
284
  if(ivar.eq.iu.or.ivar.eq.iv.or.ivar.eq.iw.or.     &
 
285
       ivar.eq.ir11.or.ivar.eq.ir12.or.             &
 
286
       ivar.eq.ir13.or.ivar.eq.ir22.or.             &
 
287
       ivar.eq.ir23.or.ivar.eq.ir33) then
 
288
 
 
289
    !    Pour la vitesse et les tensions de Reynolds, et les tpucou
 
290
    !      seules seront echangees les informations sur les faces periodiques
 
291
    !      de translation dans percom ; on ne touche pas aux informations
 
292
    !      relatives aux faces de periodicite de rotation.
 
293
    idimte = 0
 
294
    itenso = 1
 
295
 
 
296
    !      Lors de la resolution par increments, on echangera egalement les
 
297
    !      informations relatives aux faces de periodicite de translation.
 
298
    !      Pour les faces de periodicite de rotation, l'increment sera
 
299
    !      annule dans percom (iinvpe=2).
 
300
    iinvpe = 2
 
301
 
 
302
  endif
383
303
 
384
304
endif
385
305
 
387
307
! 1.  CONSTRUCTION MATRICE "SIMPLIFIEE" DE RESOLUTION
388
308
!===============================================================================
389
309
 
390
 
 
391
310
call matrix                                                       &
392
311
!==========
393
312
 ( ncelet , ncel   , nfac   , nfabor ,                            &
414
333
  iagmax = iagmx0(ivar)
415
334
  nagmax = nagmx0(ivar)
416
335
  npstmg = ncpmgr(ivar)
417
 
  lchain = 8
 
336
  lchain = 16
418
337
 
419
338
  call clmlga                                                     &
420
339
  !==========
421
 
 ( chaine(1:8) ,     lchain ,                                     &
 
340
 ( chaine(1:16) ,    lchain ,                                     &
422
341
   ncelet , ncel   , nfac   ,                                     &
423
342
   isym   , iagmax , nagmax , npstmg , iwarnp ,                   &
424
343
   ngrmax , ncegrm ,                                              &
 
344
   rlxp1  ,                                                       &
425
345
   dam    , xam    )
426
346
 
427
347
endif
445
365
  iccocg = 1
446
366
  call bilsc2                                                     &
447
367
  !==========
448
 
 ( idebia , idebra ,                                              &
449
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
450
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
451
 
   nvar   , nscal  , nphas  ,                                     &
452
 
   nideve , nrdeve , nituse , nrtuse ,                            &
 
368
 ( nvar   , nscal  ,                                              &
453
369
   idtvar , ivar   , iconvp , idiffp , nswrgp , imligp , ircflp , &
454
370
   ischcp , isstpp , inc    , imrgra , iccocg ,                   &
455
371
   ipp    , iwarnp ,                                              &
456
372
   blencp , epsrgp , climgp , extrap , relaxp , thetex ,          &
457
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
458
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
459
 
   idevel , ituser , ia     ,                                     &
460
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
461
373
   pvara  , pvara  ,  coefap , coefbp , cofafp , cofbfp ,         &
462
374
   flumas , flumab , viscfs , viscbs ,                            &
463
 
   smbrp  ,                                                       &
464
 
!        ------
465
 
   w1     , w2     , w3     , w4     , w5     , w6     ,          &
466
 
   rdevel , rtuser , ra     )
 
375
   smbrp  )
467
376
endif
468
377
 
469
378
!     AVANT DE BOUCLER SUR LES SWEEP, ON STOCKE LE SECOND MEMBRE SANS
519
428
 
520
429
  call bilsc2                                                     &
521
430
  !==========
522
 
 ( idebia , idebra ,                                              &
523
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
524
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
525
 
   nvar   , nscal  , nphas  ,                                     &
526
 
   nideve , nrdeve , nituse , nrtuse ,                            &
 
431
 ( nvar   , nscal  ,                                              &
527
432
   idtvar , ivar   , iconvp , idiffp , nswrgp , imligp , ircflp , &
528
433
   ischcp , isstpp , inc    , imrgra , iccocg ,                   &
529
434
   ipp    , iwarnp ,                                              &
530
435
   blencp , epsrgp , climgp , extrap , relaxp , thetap ,          &
531
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
532
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
533
 
   idevel , ituser , ia     ,                                     &
534
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
535
436
   pvar   , pvara  , coefap , coefbp , cofafp , cofbfp ,          &
536
437
   flumas , flumab , viscfs , viscbs ,                            &
537
 
   smbrp  ,                                                       &
538
 
!        ------
539
 
   w1     , w2     , w3     , w4     , w5     , w6     ,          &
540
 
   rdevel , rtuser , ra     )
 
438
   smbrp  )
541
439
 
542
440
  call prodsc(ncelet,ncel,isqrt,smbrp,smbrp,residu)
543
441
 
554
452
!         Pour les autres variables (scalaires) IINVPE=1 permettra de
555
453
!         tout echanger, meme si c'est superflu.
556
454
  if( isweep.eq.1 ) then
 
455
    ! Allocate a temporary array
 
456
    allocate(w1(ncelet))
557
457
    if(iinvpe.eq.2) then
558
458
      iinvpp = 3
559
459
    else
566
466
    enddo
567
467
    call prodsc(ncelet,ncel,isqrt,w1,w1,rnorm)
568
468
    rnsmbr(ipp) = rnorm
 
469
    ! Free memory
 
470
    deallocate(w1)
569
471
  endif
570
472
 
571
473
! ---> RESOLUTION IMPLICITE SUR L'INCREMENT DPVAR
573
475
  do iel = 1, ncel
574
476
    dpvar(iel) = 0.d0
575
477
  enddo
 
478
  ibsize = 1
576
479
 
577
480
  call invers                                                     &
578
481
  !==========
579
 
 ( cnom   , idebia , idebra ,                                     &
580
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
581
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
582
 
   nideve , nrdeve , nituse , nrtuse ,                            &
583
 
   isym   , ipol   , ireslq , nitmap , imgrp  ,                   &
 
482
 ( cnom   , isym   , ibsize ,                                     &
 
483
   ipol   , ireslq , nitmap , imgrp  ,                            &
584
484
   ncymxp , nitmfp ,                                              &
585
485
   iwarnp , nfecra , niterf , icycle , iinvpe ,                   &
586
486
   epsilp , rnorm  , residu ,                                     &
587
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
588
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
589
 
   idevel , ituser , ia     ,                                     &
590
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
591
 
   dam    , xam    , smbrp  , dpvar  ,                            &
592
 
   w3     , w4     , w5     , w6     , w7     , w8     ,          &
593
 
   rdevel , rtuser , ra     )
 
487
   dam    , xam    , smbrp  , dpvar  )
594
488
 
595
489
 
596
490
  nbivar(ipp) = niterf
629
523
 
630
524
if( residu.le.epsrsp*rnorm ) then
631
525
   if(iwarnp.ge.1) then
632
 
      write( nfecra,1000) cnom,isweep,residu,rnorm
 
526
      write(nfecra,1000) cnom,isweep,residu,rnorm
633
527
   endif
634
528
   goto 200
635
529
endif
636
530
 
637
531
if(iwarnp.ge.3) then
638
 
   write( nfecra,1000) cnom,isweep,residu,rnorm
 
532
   write(nfecra,1000) cnom,isweep,residu,rnorm
639
533
endif
640
534
 
641
535
 100  continue
642
536
 
643
537
if(iwarnp.ge.2) then
644
 
   write( nfecra,1100)cnom, nswmod
 
538
   write(nfecra,1100) cnom, nswmod
645
539
endif
646
540
 
647
541
!===============================================================================
672
566
 
673
567
  call bilsc2                                                     &
674
568
  !==========
675
 
 ( idebia , idebra ,                                              &
676
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
677
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
678
 
   nvar   , nscal  , nphas  ,                                     &
679
 
   nideve , nrdeve , nituse , nrtuse ,                            &
 
569
 ( nvar   , nscal  ,                                              &
680
570
   idtva0 , ivar   , iconvp , idiffp , nswrgp , imligp , ircflp , &
681
571
   ischcp , isstpp , inc    , imrgra , iccocg ,                   &
682
572
   ipp    , iwarnp ,                                              &
683
573
   blencp , epsrgp , climgp , extrap , relaxp , thetap ,          &
684
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
685
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
686
 
   idevel , ituser , ia     ,                                     &
687
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
688
574
   pvar   , pvara  , coefap , coefbp , cofafp , cofbfp ,          &
689
575
   flumas , flumab , viscfs , viscbs ,                            &
690
 
   smbrp  ,                                                       &
691
 
!        ------
692
 
   w1     , w2     , w3     , w4     , w5     , w6     ,          &
693
 
   rdevel , rtuser , ra     )
 
576
   smbrp  )
694
577
 
695
578
!     CONTRIBUTION DES NORMES L2 DES DIFFERENTES COMPOSANTES
696
 
!       DANS LE TABLEAU DAM QUI EST ICI DISPONIBLE.
 
579
!       DANS LE TABLEAU ESWORK
697
580
 
698
581
  do iel = 1,ncel
699
 
    dam(iel) = (smbrp(iel)/ volume(iel))**2
 
582
    eswork(iel) = (smbrp(iel)/ volume(iel))**2
700
583
  enddo
701
584
 
702
585
endif
705
588
 
706
589
if (imgrp.gt.0) then
707
590
  chaine = nomvar(ipp)
708
 
  lchain = 8
709
 
  call dsmlga(chaine(1:8), lchain)
 
591
  lchain = 16
 
592
  call dsmlga(chaine(1:16), lchain)
710
593
  !==========
711
594
endif
712
595
 
 
596
! Free memory
 
597
deallocate(dam, xam)
 
598
deallocate(dpvar, smbini)
 
599
 
713
600
!--------
714
601
! FORMATS
715
602
!--------
717
604
#if defined(_CS_LANG_FR)
718
605
 
719
606
 1000 format (                                                          &
720
 
 1X,A8,' : CV-DIF-TS',I5,' IT - RES= ',E12.5,' NORME= ', E12.5)
 
607
 1X,A16,' : CV-DIF-TS',I5,' IT - RES= ',E12.5,' NORME= ', E12.5)
721
608
 1100 format (                                                          &
722
609
'@                                                            ',/,&
723
610
'@ @@ ATTENTION : ',A8 ,' CONVECTION-DIFFUSION-TERMES SOURCES ',/,&
728
615
#else
729
616
 
730
617
 1000 format (                                                          &
731
 
 1X,A8,' : CV-DIF-TS',I5,' IT - RES= ',E12.5,' NORM= ', E12.5)
 
618
 1X,A16,' : CV-DIF-TS',I5,' IT - RES= ',E12.5,' NORM= ', E12.5)
732
619
 1100 format (                                                          &
733
620
'@                                                            ',/,&
734
621
'@ @@ WARNING: ',A8 ,' CONVECTION-DIFFUSION-SOURCE TERMS      ',/,&