← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/base/strpre.f90

  • Committer: Package Import Robot
  • Author(s): Sylvestre Ledru
  • Date: 2011-11-01 17:43:32 UTC
  • mto: (6.1.7 sid)
  • mto: This revision was merged to the branch mainline in revision 11.
  • Revision ID: package-import@ubuntu.com-20111101174332-tl4vk45no0x3emc3
Tags: upstream-2.1.0
Import upstream version 2.1.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/base/strpre.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 strpre &
29
24
!================
30
25
 
31
 
 ( idbia0 , idbra0 , itrale , italim , ineefl ,                   &
32
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
33
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
34
 
   nideve , nrdeve , nituse , nrtuse ,                            &
35
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml ,                   &
36
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
 
26
 ( itrale , italim , ineefl ,                                     &
37
27
   impale ,                                                       &
38
 
   idevel , ituser , ia     ,                                     &
39
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo , xyznod , volume , &
40
28
   rtp    , rtpa   , propce , propfa , propfb ,                   &
41
29
   coefa  , coefb  ,                                              &
42
 
   flmalf , flmalb , xprale , cofale , depale , rdevel , rtuser , &
43
 
   ra     )
 
30
   flmalf , flmalb , xprale , cofale , depale )
44
31
 
45
32
!===============================================================================
46
33
! FONCTION :
53
40
!__________________.____._____.________________________________________________.
54
41
! name             !type!mode ! role                                           !
55
42
!__________________!____!_____!________________________________________________!
56
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
57
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
58
43
! itrale           ! e  ! <-- ! numero d'iteration pour l'ale                  !
59
44
! italim           ! e  ! <-- ! numero d'iteration couplage implicite          !
60
45
! ineedf           ! e  ! <-- ! indicateur de sauvegarde des flux              !
61
 
! ndim             ! i  ! <-- ! spatial dimension                              !
62
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
63
 
! ncel             ! i  ! <-- ! number of cells                                !
64
 
! nfac             ! i  ! <-- ! number of interior faces                       !
65
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
66
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
67
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
68
 
! nnod             ! i  ! <-- ! number of vertices                             !
69
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
70
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
71
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
72
46
! nvar             ! i  ! <-- ! total number of variables                      !
73
47
! nscal            ! i  ! <-- ! total number of scalars                        !
74
 
! nphas            ! i  ! <-- ! number of phases                               !
75
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
76
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
77
 
! ifacel(2, nfac)  ! ia ! <-- ! interior faces -> cells connectivity           !
78
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
79
 
! ifmfbr(nfabor)   ! ia ! <-- ! boundary face family numbers                   !
80
 
! ifmcel(ncelet)   ! ia ! <-- ! cell family numbers                            !
81
 
! iprfml           ! ia ! <-- ! property numbers per family                    !
82
 
!  (nfml, nprfml)  !    !     !                                                !
83
 
! ipnfac           ! te ! <-- ! position du premier noeud de chaque            !
84
 
!   (nfac+1)       !    !     !  face interne dans nodfac (optionnel)          !
85
 
! nodfac           ! te ! <-- ! connectivite faces internes/noeuds             !
86
 
!   (lndfac)       !    !     !  (optionnel)                                   !
87
 
! ipnfbr           ! te ! <-- ! position du premier noeud de chaque            !
88
 
!   (nfabor+1)     !    !     !  face de bord dans nodfbr (optionnel)          !
89
 
! nodfbr           ! te ! <-- ! connectivite faces de bord/noeuds              !
90
 
!   (lndfbr)       !    !     !  (optionnel)                                   !
91
 
! idevel(nideve)   ! ia ! <-> ! integer work array for temporary development   !
92
 
! ituser(nituse)   ! ia ! <-> ! user-reserved integer work array               !
93
 
! ia(*)            ! ia ! --- ! main integer work array                        !
94
 
! xyzcen           ! ra ! <-- ! cell centers                                   !
95
 
!  (ndim, ncelet)  !    !     !                                                !
96
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !
97
 
!  (ndim, nfac)    !    !     !                                                !
98
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !
99
 
!  (ndim, nfabor)  !    !     !                                                !
100
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !
101
 
!  (ndim, nfac)    !    !     !                                                !
102
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !
103
 
!  (ndim, nfabor)  !    !     !                                                !
104
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !
105
 
!  (ndim, nnod)    !    !     !                                                !
106
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !
107
48
! rtp, rtpa        ! ra ! <-- ! calculated variables at cell centers           !
108
49
!  (ncelet, *)     !    !     !  (at current and previous time steps)          !
109
50
! propce(ncelet, *)! ra ! <-- ! physical properties at cell centers            !
118
59
! xprale(ncelet    ! tr ! --> ! sauvegarde de la pression, si nterup           !
119
60
!                  !    !     !    est >1                                      !
120
61
! depale(nnod,3    ! tr ! <-- ! deplacement aux noeuds                         !
121
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary development      !
122
 
! rtuser(nrtuse)   ! ra ! <-> ! user-reserved real work array                  !
123
 
! ra(*)            ! ra ! --- ! main real work array                           !
124
62
!__________________!____!_____!________________________________________________!
125
63
 
126
64
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
127
65
!            L (LOGIQUE)   .. ET TYPES COMPOSES (EX : TR TABLEAU REEL)
128
66
!     MODE : <-- donnee, --> resultat, <-> Donnee modifiee
129
67
!            --- tableau de travail
 
68
!===============================================================================
 
69
 
 
70
!===============================================================================
 
71
! Module files
 
72
!===============================================================================
 
73
 
 
74
use paramx
 
75
use dimens, only: ndimfb
 
76
use optcal
 
77
use numvar
 
78
use pointe
 
79
use albase, only: nalimx
 
80
use alstru
 
81
use alaste
 
82
use parall
 
83
use period
 
84
use entsor
 
85
use mesh
130
86
 
131
87
!===============================================================================
132
88
 
133
89
implicit none
134
90
 
135
 
!===============================================================================
136
 
! Common blocks
137
 
!===============================================================================
138
 
 
139
 
include "dimfbr.h"
140
 
include "paramx.h"
141
 
include "optcal.h"
142
 
include "numvar.h"
143
 
include "pointe.h"
144
 
include "albase.h"
145
 
include "alstru.h"
146
 
include "alaste.h"
147
 
include "period.h"
148
 
include "parall.h"
149
 
include "entsor.h"
150
 
 
151
 
!===============================================================================
152
 
 
153
91
! Arguments
154
92
 
155
 
integer          idbia0 , idbra0 , itrale , italim , ineefl
156
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
157
 
integer          nfml   , nprfml
158
 
integer          nnod   , lndfac , lndfbr , ncelbr
159
 
integer          nideve , nrdeve , nituse , nrtuse
 
93
integer          itrale , italim , ineefl
160
94
 
161
 
integer          ifacel(2,nfac) , ifabor(nfabor)
162
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
163
 
integer          iprfml(nfml,nprfml)
164
 
integer          ipnfac(nfac+1), nodfac(lndfac)
165
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr)
166
95
integer          impale(nnod)
167
 
integer          idevel(nideve), ituser(nituse)
168
 
integer          ia(*)
169
96
 
170
 
double precision xyzcen(ndim,ncelet)
171
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
172
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
173
 
double precision xyznod(ndim,nnod), volume(ncelet)
174
97
double precision rtp(ncelet,*), rtpa(ncelet,*)
175
98
double precision propce(ncelet,*)
176
99
double precision propfa(nfac,*), propfb(nfabor,*)
178
101
double precision flmalf(nfac), flmalb(nfabor), xprale(ncelet)
179
102
double precision cofale(nfabor,8)
180
103
double precision depale(nnod,3)
181
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
182
104
 
183
105
! Local variables
184
106
 
185
 
integer          idebia, idebra, ifinia
186
107
integer          istr, ii, ifac, inod, iel, indast
187
108
integer          iflmas, iflmab,iclp,iclu,iclv,iclw
188
 
integer          ilstfa
 
109
 
 
110
integer, allocatable, dimension(:) :: lstfac
189
111
 
190
112
!===============================================================================
191
113
 
194
116
! 1. INITIALISATION
195
117
!===============================================================================
196
118
 
197
 
idebia = idbia0
198
 
idebra = idbra0
199
119
 
200
 
iflmas = ipprof(ifluma(iu(1)))
201
 
iflmab = ipprob(ifluma(iu(1)))
202
 
iclp = iclrtp(ipr(1),icoef)
203
 
iclu = iclrtp(iu(1),icoef)
204
 
iclv = iclrtp(iv(1),icoef)
205
 
iclw = iclrtp(iw(1),icoef)
 
120
iflmas = ipprof(ifluma(iu))
 
121
iflmab = ipprob(ifluma(iu))
 
122
iclp = iclrtp(ipr,icoef)
 
123
iclu = iclrtp(iu,icoef)
 
124
iclv = iclrtp(iv,icoef)
 
125
iclw = iclrtp(iw,icoef)
206
126
 
207
127
!===============================================================================
208
128
! 2. PREDICTION DU DEPLACEMENT DES STRUCTURES
258
178
  endif
259
179
 
260
180
  do ifac = 1, nfabor
261
 
    istr = ia(iidfst+ifac-1)
 
181
    istr = idfstr(ifac)
262
182
    if (istr.gt.0) then
263
183
      do ii = ipnfbr(ifac), ipnfbr(ifac+1)-1
264
184
        inod = nodfbr(ii)
280
200
if (nbaste.gt.0) then
281
201
 
282
202
  do ifac = 1, nfabor
283
 
    istr = ia(iidfst+ifac-1)
 
203
    istr = idfstr(ifac)
284
204
    if (istr.lt.0) then
285
205
      do ii = ipnfbr(ifac), ipnfbr(ifac+1)-1
286
206
        inod = nodfbr(ii)
297
217
 
298
218
! Reception des deplacements predits et remplissage de depale
299
219
 
300
 
    ilstfa = idebia
301
 
    ifinia = ilstfa + nbfast
302
 
    CALL IASIZE('STRPRE',IFINIA)
 
220
    ! Allocate a temporary array
 
221
    allocate(lstfac(nbfast))
303
222
 
304
223
    indast = 0
305
224
    do ifac = 1, nfabor
306
 
      istr = ia(iidfst+ifac-1)
 
225
      istr = idfstr(ifac)
307
226
      if (istr.lt.0) then
308
227
        indast = indast + 1
309
 
        ia(ilstfa + indast-1) = ifac
 
228
        lstfac(indast) = ifac
310
229
      endif
311
230
    enddo
312
231
 
313
 
    call astcin(ntcast, nbfast, ia(ilstfa), depale)
 
232
    call astcin(ntcast, nbfast, lstfac, depale)
314
233
    !==========
315
234
 
 
235
    ! Free memory
 
236
    deallocate(lstfac)
 
237
 
316
238
  endif
317
239
 
318
240
endif
346
268
    enddo
347
269
    if (nterup.gt.1) then
348
270
      do iel = 1, ncelet
349
 
        xprale(iel) = rtpa(iel,ipr(1))
 
271
        xprale(iel) = rtpa(iel,ipr)
350
272
      enddo
351
273
    endif
352
274
  endif