← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/base/stdtcl.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/stdtcl.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 stdtcl &
29
24
!================
30
25
 
31
 
 ( idbia0 , idbra0 ,                                              &
32
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
33
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
34
 
   nvar   , nscal  , nphas  , nbzfmx , nozfmx ,                   &
35
 
   nideve , nrdeve , nituse , nrtuse ,                            &
36
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
37
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
 
26
 ( nvar   , nscal  , nbzfmx , nozfmx ,                            &
38
27
   iqimp  , icalke , qimp   , dh     , xintur ,                   &
39
28
   icodcl , itrifb , itypfb , iznfbr , ilzfbr ,                   &
40
 
   idevel , ituser , ia     ,                                     &
41
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
42
29
   dt     , rtp    , rtpa   , propce , propfa , propfb ,          &
43
30
   coefa  , coefb  , rcodcl ,                                     &
44
 
   w1     , w2     , w3     , w4     , w5     , w6     ,          &
45
 
   coefu  , qcalc  ,                                              &
46
 
   rdevel , rtuser , ra     )
 
31
   qcalc  )
47
32
 
48
33
!===============================================================================
49
34
! FONCTION :
59
44
!__________________.____._____.________________________________________________.
60
45
! name             !type!mode ! role                                           !
61
46
!__________________!____!_____!________________________________________________!
62
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
63
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
64
 
! ndim             ! i  ! <-- ! spatial dimension                              !
65
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
66
 
! ncel             ! i  ! <-- ! number of cells                                !
67
 
! nfac             ! i  ! <-- ! number of interior faces                       !
68
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
69
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
70
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
71
 
! nnod             ! i  ! <-- ! number of vertices                             !
72
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
73
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
74
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
75
47
! nvar             ! i  ! <-- ! total number of variables                      !
76
48
! nscal            ! i  ! <-- ! total number of scalars                        !
77
 
! nphas            ! i  ! <-- ! number of phases                               !
78
49
! nbzfmx           ! e  ! <-- ! nb max de zones de faces de bord               !
79
50
! nozfmx           ! e  ! <-- ! numero max de zones de faces de bord           !
80
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
81
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
82
 
! ifacel(2, nfac)  ! ia ! <-- ! interior faces -> cells connectivity           !
83
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
84
 
! ifmfbr(nfabor)   ! ia ! <-- ! boundary face family numbers                   !
85
 
! ifmcel(ncelet)   ! ia ! <-- ! cell family numbers                            !
86
 
! iprfml           ! ia ! <-- ! property numbers per family                    !
87
 
!  (nfml, nprfml)  !    !     !                                                !
88
 
! ipnfac(nfac+1)   ! ia ! <-- ! interior faces -> vertices index (optional)    !
89
 
! nodfac(lndfac)   ! ia ! <-- ! interior faces -> vertices list (optional)     !
90
 
! ipnfbr(nfabor+1) ! ia ! <-- ! boundary faces -> vertices index (optional)    !
91
 
! nodfbr(lndfbr)   ! ia ! <-- ! boundary faces -> vertices list (optional)     !
92
51
! icodcl           ! te ! --> ! code de condition limites aux faces            !
93
52
!  (nfabor,nvar    !    !     !  de bord                                       !
94
53
!                  !    !     ! = 1   -> dirichlet                             !
99
58
!                  !    !     ! = 9   -> entree/sortie libre (vitesse          !
100
59
!                  !    !     !  entrante eventuelle     bloquee               !
101
60
! itrifb           ! ia ! <-- ! indirection for boundary faces ordering        !
102
 
!  (nfabor, nphas) !    !     !                                                !
103
61
! itypfb           ! ia ! <-- ! boundary face types                            !
104
 
!  (nfabor, nphas) !    !     !                                                !
105
62
! iznfbr           ! te ! <-- ! numero de zone de la face de bord              !
106
63
! (nfabor)         !    !     !                                                !
107
64
! ilzfbr(nbzfmx    ! te ! <-- ! tableau de travail                             !
108
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
109
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
110
 
! ia(*)            ! ia ! --- ! main integer work array                        !
111
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
112
 
!  (ndim, ncelet)  !    !     !                                                !
113
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
114
 
!  (ndim, nfac)    !    !     !                                                !
115
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
116
 
!  (ndim, nfabor)  !    !     !                                                !
117
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
118
 
!  (ndim, nfac)    !    !     !                                                !
119
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
120
 
!  (ndim, nfabor)  !    !     !                                                !
121
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !
122
 
!  (ndim, nnod)    !    !     !                                                !
123
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !
124
65
! dt(ncelet)       ! ra ! <-- ! time step (per cell)                           !
125
66
! rtp, rtpa        ! ra ! <-- ! calculated variables at cell centers           !
126
67
!  (ncelet, *)     !    !     !  (at current and previous time steps)          !
141
82
!                  !    !     ! pour la pression             dt*gradp          !
142
83
!                  !    !     ! pour les scalaires                             !
143
84
!                  !    !     !        cp*(viscls+visct/sigmas)*gradt          !
144
 
! w1,2,3,4,5,6     ! ra ! --- ! work arrays                                    !
145
 
!  (ncelet)        !    !     !  (computation of pressure gradient)            !
146
 
! coefu            ! ra ! --- ! work array                                     !
147
 
!  (nfabor, 3)     !    !     !  (computation of pressure gradient)            !
148
85
! qcalc(nozfmx)    ! tr ! --- ! tab de travail (debit par zone)                !
149
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
150
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
151
 
! ra(*)            ! ra ! --- ! main real work array                           !
152
86
!__________________!____!_____!________________________________________________!
153
87
 
154
88
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
157
91
!            --- tableau de travail
158
92
!===============================================================================
159
93
 
 
94
!===============================================================================
 
95
! Module files
 
96
!===============================================================================
 
97
 
 
98
use paramx
 
99
use numvar
 
100
use optcal
 
101
use cstphy
 
102
use cstnum
 
103
use entsor
 
104
use parall
 
105
use mesh
 
106
 
 
107
!===============================================================================
 
108
 
160
109
implicit none
161
110
 
162
 
!===============================================================================
163
 
! Common blocks
164
 
!===============================================================================
165
 
 
166
 
! Arguments
167
 
 
168
 
include "paramx.h"
169
 
include "numvar.h"
170
 
include "optcal.h"
171
 
include "cstphy.h"
172
 
include "cstnum.h"
173
 
include "entsor.h"
174
 
include "parall.h"
175
 
 
176
 
!===============================================================================
177
 
 
178
 
! Arguments
179
 
 
180
 
integer          idbia0 , idbra0
181
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
182
 
integer          nfml   , nprfml , nozfmx
183
 
integer          nnod   , lndfac , lndfbr , ncelbr
184
 
integer          nvar   , nscal  , nphas  , nbzfmx
185
 
integer          nideve , nrdeve , nituse , nrtuse
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)
 
111
! Arguments
 
112
 
 
113
integer          nozfmx
 
114
integer          nvar   , nscal  , nbzfmx
 
115
 
191
116
integer          iqimp(nozfmx), icalke(nozfmx)
192
117
integer          icodcl(nfabor,nvar)
193
 
integer          itrifb(nfabor,nphas), itypfb(nfabor,nphas)
 
118
integer          itrifb(nfabor), itypfb(nfabor)
194
119
integer          iznfbr(nfabor), ilzfbr(nbzfmx)
195
 
integer          idevel(nideve), ituser(nituse), ia(*)
196
120
 
197
121
double precision qimp(nozfmx), dh(nozfmx), xintur(nozfmx)
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
122
double precision dt(ncelet), rtp(ncelet,*), rtpa(ncelet,*)
203
123
double precision propce(ncelet,*)
204
124
double precision propfa(nfac,*), propfb(nfabor,*)
205
125
double precision coefa(nfabor,*), coefb(nfabor,*)
206
126
double precision rcodcl(nfabor,nvar,3)
207
 
double precision w1(ncelet),w2(ncelet),w3(ncelet)
208
 
double precision w4(ncelet),w5(ncelet),w6(ncelet)
209
 
double precision coefu(nfabor,ndim)
210
127
double precision qcalc(nozfmx)
211
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
212
128
 
213
129
! Local variables
214
130
 
215
 
integer          idebia, idebra
216
 
integer          iphas, ifac, izone, ifvu, izonem
 
131
integer          ifac, izone, ifvu, izonem
217
132
integer          nozapm, nzfppp
218
133
integer          ipbrom, icke, ipcvis, ii, iel, iok
219
134
double precision qisqc, viscla, d2s3, uref2, rhomoy, dhy, xiturb
229
144
! 1.  INITIALISATIONS
230
145
!===============================================================================
231
146
 
232
 
idebia = idbia0
233
 
idebra = idbra0
234
147
 
235
 
iphas = 1
236
 
ipbrom = ipprob(irom  (iphas))
237
 
ipcvis = ipproc(iviscl(iphas))
 
148
ipbrom = ipprob(irom  )
 
149
ipcvis = ipproc(iviscl)
238
150
 
239
151
d2s3 = 2.d0/3.d0
240
152
 
276
188
 
277
189
#if defined(_CS_LANG_FR)
278
190
 
279
 
 1000 format(                                                           &
280
 
'@                                                            ',/,&
281
 
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
282
 
'@                                                            ',/,&
283
 
'@ @@ ATTENTION : LES CONDITIONS AUX LIMITES DONNEES PAR      ',/,&
284
 
'@    =========                                               ',/,&
285
 
'@         L''INTERFACE SONT INCOMPLETES OU INEXISTANTES      ',/,&
286
 
'@                                                            ',/,&
287
 
'@  Il y a ',I10,' faces pour lesquelles aucune zone          ',/,&
288
 
'@  n''est d�finie.                                           ',/,&
289
 
'@                                                            ',/,&
290
 
'@  Le calcul continue.                                       ',/,&
291
 
'@                                                            ',/,&
292
 
'@  Compl�ter les conditions aux limites dans le              ',/,&
293
 
'@  sous-programme usclim.F.                                  ',/,&
294
 
'@                                                            ',/,&
295
 
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
296
 
'@                                                            ',/)
297
191
 1001 format(                                                           &
298
192
'@                                                            ',/,&
299
193
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
319
213
 
320
214
#else
321
215
 
322
 
 1000 format(                                                           &
323
 
'@                                                            ',/,&
324
 
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
325
 
'@                                                            ',/,&
326
 
'@ @@ WARNING: THE BOUNDARY CONDITIONS GIVEN BY THE           ',/,&
327
 
'@    ========                                                ',/,&
328
 
'@         INTERFACE ARE INCOMPLETE OR NON-EXISTANT           ',/,&
329
 
'@                                                            ',/,&
330
 
'@  There are ',I10,' faces for which no zone is defined.     ',/,&
331
 
'@                                                            ',/,&
332
 
'@  The calulation will run.                                  ',/,&
333
 
'@                                                            ',/,&
334
 
'@  Complete the boundary conditions in the subroutine usclim.',/,&
335
 
'@                                                            ',/,&
336
 
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
337
 
'@                                                            ',/)
338
216
 1001 format(                                                           &
339
217
'@                                                            ',/,&
340
218
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
401
279
  if (izone .gt. 0) then
402
280
    if (iqimp(izone).eq.2) then
403
281
      qcalc(izone) = qcalc(izone) -                               &
404
 
         ( rcodcl(ifac,iu(iphas),1)*surfbo(1,ifac) +              &
405
 
           rcodcl(ifac,iv(iphas),1)*surfbo(2,ifac) +              &
406
 
           rcodcl(ifac,iw(iphas),1)*surfbo(3,ifac) )
 
282
         ( rcodcl(ifac,iu,1)*surfbo(1,ifac) +              &
 
283
           rcodcl(ifac,iv,1)*surfbo(2,ifac) +              &
 
284
           rcodcl(ifac,iw,1)*surfbo(3,ifac) )
407
285
    else
408
286
      qcalc(izone) = qcalc(izone) - propfb(ifac,ipbrom) *         &
409
 
         ( rcodcl(ifac,iu(iphas),1)*surfbo(1,ifac) +              &
410
 
           rcodcl(ifac,iv(iphas),1)*surfbo(2,ifac) +              &
411
 
           rcodcl(ifac,iw(iphas),1)*surfbo(3,ifac) )
 
287
         ( rcodcl(ifac,iu,1)*surfbo(1,ifac) +              &
 
288
           rcodcl(ifac,iv,1)*surfbo(2,ifac) +              &
 
289
           rcodcl(ifac,iw,1)*surfbo(3,ifac) )
412
290
    endif
413
291
  endif
414
292
enddo
444
322
  if (izone .gt. 0) then
445
323
    if ( iqimp(izone).eq.1 .or.  iqimp(izone).eq.2) then
446
324
      qisqc = qimp(izone)/qcalc(izone)
447
 
      rcodcl(ifac,iu(iphas),1) = rcodcl(ifac,iu(iphas),1)*qisqc
448
 
      rcodcl(ifac,iv(iphas),1) = rcodcl(ifac,iv(iphas),1)*qisqc
449
 
      rcodcl(ifac,iw(iphas),1) = rcodcl(ifac,iw(iphas),1)*qisqc
 
325
      rcodcl(ifac,iu,1) = rcodcl(ifac,iu,1)*qisqc
 
326
      rcodcl(ifac,iv,1) = rcodcl(ifac,iv,1)*qisqc
 
327
      rcodcl(ifac,iw,1) = rcodcl(ifac,iw,1)*qisqc
450
328
    endif
451
329
  endif
452
330
enddo
470
348
'@  Le calcul ne peut etre execute.                           ',/,&
471
349
'@                                                            ',/,&
472
350
'@  Verifier les donnees dans l''interface et en particulier  ',/,&
473
 
'@    - que le vecteur  RCODCL(IFAC,IU(IPHAS),1),             ',/,&
474
 
'@                      RCODCL(IFAC,IV(IPHAS),1),             ',/,&
475
 
'@                      RCODCL(IFAC,IW(IPHAS),1) qui determine',/,&
 
351
'@    - que le vecteur  RCODCL(IFAC,IU,1),             ',/,&
 
352
'@                      RCODCL(IFAC,IV,1),             ',/,&
 
353
'@                      RCODCL(IFAC,IW,1) qui determine',/,&
476
354
'@      la direction de la vitesse est non nul et n''est pas  ',/,&
477
355
'@      uniformement perpendiculaire aux face d''entree       ',/,&
478
356
'@    - que la surface de l''entree n''est pas nulle (ou que  ',/,&
501
379
'@  The calculation will not run.                             ',/,&
502
380
'@                                                            ',/,&
503
381
'@  Verify the data in the interface and particularly         ',/,&
504
 
'@    - that the vector RCODCL(IFAC,IU(IPHAS),1),             ',/,&
505
 
'@                      RCODCL(IFAC,IV(IPHAS),1),             ',/,&
506
 
'@                      RCODCL(IFAC,IW(IPHAS),1) which gives  ',/,&
 
382
'@    - that the vector RCODCL(IFAC,IU,1),             ',/,&
 
383
'@                      RCODCL(IFAC,IV,1),             ',/,&
 
384
'@                      RCODCL(IFAC,IW,1) which gives  ',/,&
507
385
'@      the velocity direction is non null and not uniformly  ',/,&
508
386
'@      perpendicular to the inlet faces                      ',/,&
509
387
'@    - that the inlet surface is not zero (or that the number',/,&
531
409
 
532
410
  if (izone .gt. 0) then
533
411
 
534
 
    if ( itypfb(ifac,iphas).eq.ientre ) then
 
412
    if ( itypfb(ifac).eq.ientre ) then
535
413
 
536
414
! ----  Traitement automatique de la turbulence
537
415
 
544
422
!            de reference et de l'intensite turvulente
545
423
!            adaptes a l'entree courante si ICALKE = 2
546
424
 
547
 
        uref2 = rcodcl(ifac,iu(iphas),1)**2                       &
548
 
              + rcodcl(ifac,iv(iphas),1)**2                       &
549
 
              + rcodcl(ifac,iw(iphas),1)**2
 
425
        uref2 = rcodcl(ifac,iu,1)**2                       &
 
426
              + rcodcl(ifac,iv,1)**2                       &
 
427
              + rcodcl(ifac,iw,1)**2
550
428
        uref2 = max(uref2,epzero)
551
429
        rhomoy = propfb(ifac,ipbrom)
552
430
        iel    = ifabor(ifac)
568
446
        ( uref2, xiturb, dhy, cmu, xkappa, xkent, xeent )
569
447
        endif
570
448
 
571
 
        if (itytur(iphas).eq.2) then
572
 
 
573
 
          rcodcl(ifac,ik(iphas),1)  = xkent
574
 
          rcodcl(ifac,iep(iphas),1) = xeent
575
 
 
576
 
        elseif (itytur(iphas).eq.3) then
577
 
 
578
 
          rcodcl(ifac,ir11(iphas),1) = d2s3*xkent
579
 
          rcodcl(ifac,ir22(iphas),1) = d2s3*xkent
580
 
          rcodcl(ifac,ir33(iphas),1) = d2s3*xkent
581
 
          rcodcl(ifac,ir12(iphas),1) = 0.d0
582
 
          rcodcl(ifac,ir13(iphas),1) = 0.d0
583
 
          rcodcl(ifac,ir23(iphas),1) = 0.d0
584
 
          rcodcl(ifac,iep(iphas),1)  = xeent
585
 
 
586
 
        elseif (iturb(iphas).eq.50) then
587
 
 
588
 
          rcodcl(ifac,ik(iphas),1)   = xkent
589
 
          rcodcl(ifac,iep(iphas),1)  = xeent
590
 
          rcodcl(ifac,iphi(iphas),1) = d2s3
591
 
          rcodcl(ifac,ifb(iphas),1)  = 0.d0
592
 
 
593
 
        elseif (iturb(iphas).eq.60) then
594
 
 
595
 
          rcodcl(ifac,ik(iphas),1)   = xkent
596
 
          rcodcl(ifac,iomg(iphas),1) = xeent/cmu/xkent
 
449
        if (itytur.eq.2) then
 
450
 
 
451
          rcodcl(ifac,ik,1)  = xkent
 
452
          rcodcl(ifac,iep,1) = xeent
 
453
 
 
454
        elseif (itytur.eq.3) then
 
455
 
 
456
          rcodcl(ifac,ir11,1) = d2s3*xkent
 
457
          rcodcl(ifac,ir22,1) = d2s3*xkent
 
458
          rcodcl(ifac,ir33,1) = d2s3*xkent
 
459
          rcodcl(ifac,ir12,1) = 0.d0
 
460
          rcodcl(ifac,ir13,1) = 0.d0
 
461
          rcodcl(ifac,ir23,1) = 0.d0
 
462
          rcodcl(ifac,iep,1)  = xeent
 
463
 
 
464
        elseif (itytur.eq.5) then
 
465
 
 
466
          rcodcl(ifac,ik,1)   = xkent
 
467
          rcodcl(ifac,iep,1)  = xeent
 
468
          rcodcl(ifac,iphi,1) = d2s3
 
469
          if(iturb.eq.50) then
 
470
            rcodcl(ifac,ifb,1)  = 0.d0
 
471
          elseif(iturb.eq.51) then
 
472
            rcodcl(ifac,ial,1)  = 0.d0
 
473
          endif
 
474
 
 
475
        elseif (iturb.eq.60) then
 
476
 
 
477
          rcodcl(ifac,ik,1)   = xkent
 
478
          rcodcl(ifac,iomg,1) = xeent/cmu/xkent
597
479
 
598
480
        endif
599
481