← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/base/projts.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/projts.f90
1
 
!-------------------------------------------------------------------------------
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
25
 
 
26
 
!-------------------------------------------------------------------------------
27
 
 
28
 
subroutine projts &
29
 
!================
30
 
 
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 ,                            &
36
 
   init   , inc    , imrgra , iccocg , nswrgu , imligu ,          &
37
 
   iwarnu , nfecra ,                                              &
38
 
   epsrgu , climgu ,                                              &
39
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
40
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
41
 
   idevel , ituser , ia     ,                                     &
42
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
43
 
   fextx  , fexty  , fextz  ,                                     &
44
 
   coefbp ,                                                       &
45
 
   flumas , flumab , viscf  , viscb  ,                            &
46
 
   viselx , visely , viselz ,                                     &
47
 
   rdevel , rtuser , ra     )
48
 
 
49
 
!===============================================================================
50
 
! FONCTION :
51
 
! ----------
52
 
 
53
 
! PROJECTION SUR LES FACES DES TERMES DE FORCE EXTERIEURE
54
 
! GENERANT UNE PRESSION HYDROSTATIQUE
55
 
! EN FAIT, LE TERME CALCULE EST : DTij FEXTij.Sij
56
 
!                                      ----   -
57
 
! ET IL EST AJOUTE AU FLUX DE MASSE.
58
 
! LE CALCUL EST FAIT DE MANIERE COMPATIBLE AVEC ITRMAS (POUR LES
59
 
! FACES INTERNES) ET DE MANIERE A CORRIGER L'ERREUR SUR LA CL
60
 
! DE PRESSION EN PAROI (dP/dn=0 n'est pas adapte en fait)
61
 
 
62
 
!-------------------------------------------------------------------------------
63
 
! Arguments
64
 
!__________________.____._____.________________________________________________.
65
 
! name             !type!mode ! role                                           !
66
 
!__________________!____!_____!________________________________________________!
67
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
68
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
69
 
! ndim             ! i  ! <-- ! spatial dimension                              !
70
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
71
 
! ncel             ! i  ! <-- ! number of cells                                !
72
 
! nfac             ! i  ! <-- ! number of interior faces                       !
73
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
74
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
75
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
76
 
! nnod             ! i  ! <-- ! number of vertices                             !
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
 
! nvar             ! i  ! <-- ! total number of variables                      !
81
 
! nscal            ! i  ! <-- ! total number of scalars                        !
82
 
! nphas            ! i  ! <-- ! number of phases                               !
83
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
84
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
85
 
! init             ! e  ! <-- ! > 0 : initialisation du flux de masse          !
86
 
! inc              ! e  ! <-- ! indicateur = 0 resol sur increment             !
87
 
!                  !    !     !              1 sinon                           !
88
 
! imrgra           ! e  ! <-- ! indicateur = 0 gradrc 97                       !
89
 
!                  ! e  ! <-- !            = 1 gradmc 99                       !
90
 
! iccocg           ! e  ! <-- ! indicateur = 1 pour recalcul de cocg           !
91
 
!                  !    !     !              0 sinon                           !
92
 
! nswrgu           ! e  ! <-- ! nombre de sweep pour reconstruction            !
93
 
!                  !    !     !             des gradients                      !
94
 
! imligu           ! e  ! <-- ! methode de limitation du gradient              !
95
 
!                  !    !     !  < 0 pas de limitation                         !
96
 
!                  !    !     !  = 0 a partir des gradients voisins            !
97
 
!                  !    !     !  = 1 a partir du gradient moyen                !
98
 
! iwarnu           ! e  ! <-- ! niveau d'impression                            !
99
 
! nfecra           ! e  ! <-- ! unite du fichier sortie std                    !
100
 
! epsrgu           ! r  ! <-- ! precision relative pour la                     !
101
 
!                  !    !     !  reconstruction des gradients 97               !
102
 
! climgu           ! r  ! <-- ! coef gradient*distance/ecart                   !
103
 
! ifacel(2, nfac)  ! ia ! <-- ! interior faces -> cells connectivity           !
104
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
105
 
! ifmfbr(nfabor)   ! ia ! <-- ! boundary face family numbers                   !
106
 
! ifmcel(ncelet)   ! ia ! <-- ! cell family numbers                            !
107
 
! iprfml           ! ia ! <-- ! property numbers per family                    !
108
 
!  (nfml, nprfml)  !    !     !                                                !
109
 
! ipnfac(nfac+1)   ! ia ! <-- ! interior faces -> vertices index (optional)    !
110
 
! nodfac(lndfac)   ! ia ! <-- ! interior faces -> vertices list (optional)     !
111
 
! ipnfbr(nfabor+1) ! ia ! <-- ! boundary faces -> vertices index (optional)    !
112
 
! nodfbr(lndfbr)   ! ia ! <-- ! boundary faces -> vertices list (optional)     !
113
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
114
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
115
 
! ia(*)            ! ia ! --- ! main integer work array                        !
116
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
117
 
!  (ndim, ncelet)  !    !     !                                                !
118
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
119
 
!  (ndim, nfac)    !    !     !                                                !
120
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
121
 
!  (ndim, nfabor)  !    !     !                                                !
122
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
123
 
!  (ndim, nfac)    !    !     !                                                !
124
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
125
 
!  (ndim, nfabor)  !    !     !                                                !
126
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !
127
 
!  (ndim, nnod)    !    !     !                                                !
128
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !
129
 
! coefbp(nfabor    ! tr ! <-- ! tableaux des cond lim de pression              !
130
 
! flumas(nfac)     ! tr ! <-- ! flux de masse aux faces internes               !
131
 
! flumab(nfabor    ! tr ! <-- ! flux de masse aux faces de bord                !
132
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
133
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
134
 
! ra(*)            ! ra ! --- ! main real work array                           !
135
 
!__________________!____!_____!________________________________________________!
136
 
 
137
 
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
138
 
!            L (LOGIQUE)   .. ET TYPES COMPOSES (EX : TR TABLEAU REEL)
139
 
!     MODE : <-- donnee, --> resultat, <-> Donnee modifiee
140
 
!            --- tableau de travail
141
 
!===============================================================================
142
 
 
143
 
implicit none
144
 
 
145
 
!===============================================================================
146
 
! Common blocks
147
 
!===============================================================================
148
 
 
149
 
include "paramx.h"
150
 
include "pointe.h"
151
 
 
152
 
!===============================================================================
153
 
 
154
 
! Arguments
155
 
 
156
 
integer          idbia0 , idbra0
157
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
158
 
integer          nfml   , nprfml
159
 
integer          nnod   , lndfac , lndfbr , ncelbr
160
 
integer          nvar   , nscal  , nphas
161
 
integer          nideve , nrdeve , nituse , nrtuse
162
 
integer          init   , inc    , imrgra , iccocg
163
 
integer          nswrgu , imligu
164
 
integer          iwarnu , nfecra
165
 
double precision epsrgu , climgu
166
 
 
167
 
integer          ifacel(2,nfac) , ifabor(nfabor)
168
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
169
 
integer          iprfml(nfml,nprfml)
170
 
integer          ipnfac(nfac+1), nodfac(lndfac)
171
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr)
172
 
integer          idevel(nideve), ituser(nituse), ia(*)
173
 
 
174
 
double precision xyzcen(ndim,ncelet)
175
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
176
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
177
 
double precision xyznod(ndim,nnod), volume(ncelet)
178
 
double precision pond
179
 
double precision fextx(ncelet),fexty(ncelet),fextz(ncelet)
180
 
double precision viscf(nfac), viscb(nfabor)
181
 
double precision viselx(ncelet), visely(ncelet), viselz(ncelet)
182
 
double precision coefbp(nfabor)
183
 
double precision flumas(nfac), flumab(nfabor)
184
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
185
 
 
186
 
! Local variables
187
 
 
188
 
integer          idebia, idebra
189
 
integer          ifac, ii, jj, iii
190
 
double precision dijpfx,dijpfy,dijpfz
191
 
double precision diipx,diipy,diipz
192
 
double precision djjpx,djjpy,djjpz
193
 
double precision dist,surfn
194
 
 
195
 
!===============================================================================
196
 
 
197
 
!===============================================================================
198
 
! 1.  INITIALISATION
199
 
!===============================================================================
200
 
 
201
 
idebia = idbia0
202
 
idebra = idbra0
203
 
 
204
 
 
205
 
 
206
 
if( init.eq.1 ) then
207
 
  do ifac = 1, nfac
208
 
    flumas(ifac) = 0.d0
209
 
  enddo
210
 
  do ifac = 1, nfabor
211
 
    flumab(ifac) = 0.d0
212
 
  enddo
213
 
 
214
 
elseif(init.ne.0) then
215
 
  write(nfecra,1000) init
216
 
  call csexit(1)
217
 
endif
218
 
 
219
 
!===============================================================================
220
 
! 2.  CALCUL DU FLUX DE MASSE SANS TECHNIQUE DE RECONSTRUCTION
221
 
!===============================================================================
222
 
 
223
 
if( nswrgu.le.1 ) then
224
 
 
225
 
!     FLUX DE MASSE SUR LES FACETTES FLUIDES
226
 
 
227
 
  do ifac = 1, nfac
228
 
 
229
 
    ii = ifacel(1,ifac)
230
 
    jj = ifacel(2,ifac)
231
 
 
232
 
    flumas(ifac) =  flumas(ifac)                                  &
233
 
         + viscf(ifac)*(                                          &
234
 
           (cdgfac(1,ifac)-xyzcen(1,ii))*fextx(ii)                &
235
 
          +(cdgfac(2,ifac)-xyzcen(2,ii))*fexty(ii)                &
236
 
          +(cdgfac(3,ifac)-xyzcen(3,ii))*fextz(ii)                &
237
 
          -(cdgfac(1,ifac)-xyzcen(1,jj))*fextx(jj)                &
238
 
          -(cdgfac(2,ifac)-xyzcen(2,jj))*fexty(jj)                &
239
 
          -(cdgfac(3,ifac)-xyzcen(3,jj))*fextz(jj) )
240
 
 
241
 
  enddo
242
 
 
243
 
 
244
 
!     FLUX DE MASSE SUR LES FACETTES DE BORD
245
 
 
246
 
  do ifac = 1, nfabor
247
 
 
248
 
    ii = ifabor(ifac)
249
 
    surfn = ra(isrfbn-1+ifac)
250
 
    dist  = ra(idistb-1+ifac)
251
 
 
252
 
    flumab(ifac) = flumab(ifac)+viscb(ifac)*dist/surfn            &
253
 
         *(1.d0-coefbp(ifac))*(fextx(ii)*surfbo(1,ifac)           &
254
 
         +fexty(ii)*surfbo(2,ifac)+fextz(ii)*surfbo(3,ifac) )
255
 
 
256
 
  enddo
257
 
 
258
 
 
259
 
else
260
 
 
261
 
 
262
 
!     FLUX DE MASSE SUR LES FACETTES FLUIDES
263
 
 
264
 
  do ifac = 1, nfac
265
 
 
266
 
    ii = ifacel(1,ifac)
267
 
    jj = ifacel(2,ifac)
268
 
 
269
 
    pond = ra(ipond-1+ifac)
270
 
 
271
 
!     recuperation de I'J'
272
 
    iii = idijpf-1+3*(ifac-1)
273
 
    dijpfx = ra(iii+1)
274
 
    dijpfy = ra(iii+2)
275
 
    dijpfz = ra(iii+3)
276
 
    surfn = ra(isrfan-1+ifac)
277
 
    dist  = ra(idist-1+ifac)
278
 
 
279
 
!     calcul de II' et JJ'
280
 
    diipx = cdgfac(1,ifac)-xyzcen(1,ii)-(1.d0-pond)*dijpfx
281
 
    diipy = cdgfac(2,ifac)-xyzcen(2,ii)-(1.d0-pond)*dijpfy
282
 
    diipz = cdgfac(3,ifac)-xyzcen(3,ii)-(1.d0-pond)*dijpfz
283
 
    djjpx = cdgfac(1,ifac)-xyzcen(1,jj)+pond*dijpfx
284
 
    djjpy = cdgfac(2,ifac)-xyzcen(2,jj)+pond*dijpfy
285
 
    djjpz = cdgfac(3,ifac)-xyzcen(3,jj)+pond*dijpfz
286
 
 
287
 
    flumas(ifac) =  flumas(ifac)                                  &
288
 
         + viscf(ifac)*(                                          &
289
 
           (cdgfac(1,ifac)-xyzcen(1,ii))*fextx(ii)                &
290
 
          +(cdgfac(2,ifac)-xyzcen(2,ii))*fexty(ii)                &
291
 
          +(cdgfac(3,ifac)-xyzcen(3,ii))*fextz(ii)                &
292
 
          -(cdgfac(1,ifac)-xyzcen(1,jj))*fextx(jj)                &
293
 
          -(cdgfac(2,ifac)-xyzcen(2,jj))*fexty(jj)                &
294
 
          -(cdgfac(3,ifac)-xyzcen(3,jj))*fextz(jj) )              &
295
 
         +surfn/dist*0.5d0*(                                      &
296
 
       (djjpx-diipx)*(viselx(ii)*fextx(ii)+viselx(jj)*fextx(jj))  &
297
 
      +(djjpy-diipy)*(visely(ii)*fexty(ii)+visely(jj)*fexty(jj))  &
298
 
      +(djjpz-diipz)*(viselz(ii)*fextz(ii)+viselz(jj)*fextz(jj)))
299
 
 
300
 
  enddo
301
 
 
302
 
 
303
 
!     FLUX DE MASSE SUR LES FACETTES DE BORD
304
 
 
305
 
  do ifac = 1, nfabor
306
 
 
307
 
    ii = ifabor(ifac)
308
 
    surfn = ra(isrfbn-1+ifac)
309
 
    dist  = ra(idistb-1+ifac)
310
 
 
311
 
    flumab(ifac) = flumab(ifac)+viscb(ifac)*dist/surfn            &
312
 
         *(1.d0-coefbp(ifac))*(fextx(ii)*surfbo(1,ifac)           &
313
 
         +fexty(ii)*surfbo(2,ifac)+fextz(ii)*surfbo(3,ifac) )
314
 
 
315
 
  enddo
316
 
endif
317
 
 
318
 
 
319
 
 
320
 
!--------
321
 
! FORMATS
322
 
!--------
323
 
 
324
 
#if defined(_CS_LANG_FR)
325
 
 
326
 
 1000 format('PROJTS APPELE AVEC INIT =',I10)
327
 
 
328
 
#else
329
 
 
330
 
 1000 format('PROJTS CALLED WITH INIT =',I10)
331
 
 
332
 
#endif
333
 
 
334
 
 
335
 
!----
336
 
! FIN
337
 
!----
338
 
 
339
 
return
340
 
 
341
 
end subroutine