← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/comb/cs_coal_thfieldconv2.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/comb/cs_coal_thfieldconv2.f90
 
1
!-------------------------------------------------------------------------------
 
2
 
 
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.
 
20
 
 
21
!-------------------------------------------------------------------------------
 
22
 
 
23
subroutine cs_coal_thfieldconv2 &
 
24
!================
 
25
 ( ncelet , ncel   ,                                              &
 
26
   rtp    , propce )
 
27
 
 
28
!===============================================================================
 
29
! FONCTION :
 
30
! --------
 
31
! CALCUL DE LA TEMPERATURE DES PARTICULES
 
32
!  EN FONCTION DE L'ENTHALPIE DU SOLIDE ET DES CONCENTRATIONS
 
33
! Arguments
 
34
!__________________.____._____.________________________________________________.
 
35
! name             !type!mode ! role                                           !
 
36
!__________________!____!_____!________________________________________________!
 
37
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
 
38
! ncel             ! i  ! <-- ! number of cells                                !
 
39
! rtp              ! tr ! <-- ! variables de calcul au centre des              !
 
40
! (ncelet,*)       !    !     !    cellules (instant courant)                  !
 
41
! propce(ncelet, *)! ra ! <-- ! physical properties at cell centers            !
 
42
! eh0              ! tr ! <-- ! tableau reel de travail                        !
 
43
! eh1              ! tr ! <-- ! tableau reel de travail                        !
 
44
!__________________!____!_____!________________________________________________!
 
45
!     TYPE : E (ENTIER), R (REEL), A (ALPHAMNUMERIQUE), T (TABLEAU)
 
46
!            L (LOGIQUE)   .. ET TYPES COMPOSES (EX : TR TABLEAU REEL)
 
47
!     MODE : <-- donnee, --> resultat, <-> Donnee modifiee
 
48
!            --- tableau de travail
 
49
!===============================================================================
 
50
 
 
51
!==============================================================================
 
52
! Module files
 
53
!==============================================================================
 
54
 
 
55
use paramx
 
56
use numvar
 
57
use optcal
 
58
use cstphy
 
59
use cstnum
 
60
use entsor
 
61
use ppppar
 
62
use ppthch
 
63
use coincl
 
64
use cpincl
 
65
use ppincl
 
66
 
 
67
!===============================================================================
 
68
 
 
69
implicit none
 
70
 
 
71
! Arguments
 
72
 
 
73
integer          ncelet, ncel
 
74
double precision rtp(ncelet,*), propce(ncelet,*)
 
75
 
 
76
! Local variables
 
77
 
 
78
integer          i      , icla   , icha   , icel
 
79
integer          ipcte1 , ipcte2
 
80
integer          ihflt2
 
81
double precision h2     , x2     , xch    , xck
 
82
double precision xash   , xnp    , xtes   , xwat
 
83
 
 
84
integer          iok1
 
85
double precision , dimension ( : )     , allocatable :: eh0,eh1
 
86
 
 
87
!===============================================================================
 
88
! Methode de conversion
 
89
!
 
90
ihflt2 = 1
 
91
!
 
92
!===============================================================================
 
93
! 1. CALCULS PRELIMINAIRES
 
94
!===============================================================================
 
95
 
 
96
!===============================================================================
 
97
! Deallocation dynamic arrays
 
98
!----
 
99
allocate(eh0(1:ncel),eh1(1:ncel),STAT=iok1)
 
100
!----
 
101
if ( iok1 > 0 ) THEN
 
102
  write(nfecra,*) ' Memory allocation error inside: '
 
103
  write(nfecra,*) '    cs_coal_thfieldconv2         '
 
104
  call csexit(1)
 
105
endif
 
106
!===============================================================================
 
107
 
 
108
! --- Initialisation des tableaux
 
109
eh0( : ) = zero
 
110
eh1( : ) = zero
 
111
 
 
112
! --- Initialisation de T2 a T1
 
113
 
 
114
ipcte1 = ipproc(itemp1)
 
115
do icla = 1, nclacp
 
116
  ipcte2 = ipproc(itemp2(icla))
 
117
  do icel = 1, ncel
 
118
    propce(icel,ipcte2) = propce(icel,ipcte1)
 
119
  enddo
 
120
enddo
 
121
 
 
122
!===============================================================================
 
123
! 2. CALCUL DE LA TEMPERATURE DES PARTICULES
 
124
!===============================================================================
 
125
 
 
126
if ( ihflt2.eq.0 ) then
 
127
 
 
128
! --> H2 fonction lineaire de T2
 
129
 
 
130
  do icla = 1, nclacp
 
131
    ipcte2 = ipproc(itemp2(icla))
 
132
    icha = ichcor(icla)
 
133
    do icel = 1, ncel
 
134
      propce(icel,ipcte2) =                                       &
 
135
            (rtp(icel,isca(ih2(icla)))-h02ch(icha))               &
 
136
            / cp2ch(icha) + trefth
 
137
    enddo
 
138
  enddo
 
139
 
 
140
else
 
141
 
 
142
! --> H2 tabule
 
143
 
 
144
  do icla = 1, nclacp
 
145
 
 
146
    ipcte2 = ipproc(itemp2(icla))
 
147
 
 
148
    i = npoc-1
 
149
    do icel = 1, ncel
 
150
      xch  = rtp(icel,isca(ixch(icla)))
 
151
      xnp  = rtp(icel,isca(inp(icla)))
 
152
      xck  = rtp(icel,isca(ixck(icla)))
 
153
      xash = xmash(icla)*xnp
 
154
      if ( ippmod(iccoal) .eq. 1 ) then
 
155
        xwat = rtp(icel,isca(ixwt(icla)))
 
156
      else
 
157
        xwat = 0.d0
 
158
      endif
 
159
 
 
160
      x2   = xch + xck + xash + xwat
 
161
 
 
162
      if ( x2 .gt. epsicp*100.d0 ) then
 
163
 
 
164
        h2   = rtp(icel,isca(ih2(icla)))/x2
 
165
 
 
166
        xtes = xmp0(icla)*xnp
 
167
 
 
168
        if ( xtes.gt.epsicp .and. x2.gt.epsicp*100.d0 ) then
 
169
          eh1(icel) = xch /x2 * ehsoli(ich(ichcor(icla) ),i+1)    &
 
170
                    + xck /x2 * ehsoli(ick(ichcor(icla) ),i+1)    &
 
171
                    + xash/x2 * ehsoli(iash(ichcor(icla)),i+1)    &
 
172
                    + xwat/x2 * ehsoli(iwat(ichcor(icla)),i+1)
 
173
          if ( h2.ge.eh1(icel) ) then
 
174
            propce(icel,ipcte2) = thc(i+1)
 
175
 
 
176
          endif
 
177
        endif
 
178
 
 
179
      endif
 
180
 
 
181
    enddo
 
182
 
 
183
    i = 1
 
184
    do icel = 1, ncel
 
185
      xch  = rtp(icel,isca(ixch(icla)))
 
186
      xnp  = rtp(icel,isca(inp(icla)))
 
187
      xck  = rtp(icel,isca(ixck(icla)))
 
188
      xash = xmash(icla)*xnp
 
189
      if ( ippmod(iccoal) .eq. 1 ) then
 
190
        xwat = rtp(icel,isca(ixwt(icla)))
 
191
      else
 
192
        xwat = 0.d0
 
193
      endif
 
194
 
 
195
      x2   = xch + xck + xash + xwat
 
196
 
 
197
      if ( x2 .gt. epsicp*100.d0 ) then
 
198
 
 
199
        h2   = rtp(icel,isca(ih2(icla)))/x2
 
200
 
 
201
        xtes = xmp0(icla)*xnp
 
202
 
 
203
        if ( xtes.gt.epsicp .and. x2.gt.epsicp*100.d0 ) then
 
204
          eh0(icel) = xch /x2 * ehsoli(ich(ichcor(icla) ),i)      &
 
205
                    + xck /x2 * ehsoli(ick(ichcor(icla) ),i)      &
 
206
                    + xash/x2 * ehsoli(iash(ichcor(icla)),i)      &
 
207
                    + xwat/x2 * ehsoli(iwat(ichcor(icla)),i)
 
208
          if ( h2.le.eh0(icel) ) then
 
209
            propce(icel,ipcte2) = thc(i)
 
210
          endif
 
211
        endif
 
212
 
 
213
      endif
 
214
 
 
215
    enddo
 
216
 
 
217
    do i = 1, npoc-1
 
218
      do icel = 1, ncel
 
219
        xch  = rtp(icel,isca(ixch(icla)))
 
220
        xnp  = rtp(icel,isca(inp(icla)))
 
221
        xck  = rtp(icel,isca(ixck(icla)))
 
222
        xash = xmash(icla)*xnp
 
223
        if ( ippmod(iccoal) .eq. 1 ) then
 
224
          xwat = rtp(icel,isca(ixwt(icla)))
 
225
        else
 
226
          xwat = 0.d0
 
227
        endif
 
228
 
 
229
        x2   = xch + xck + xash + xwat
 
230
 
 
231
        if ( x2 .gt. epsicp*100.d0 ) then
 
232
 
 
233
          h2   = rtp(icel,isca(ih2(icla)))/x2
 
234
 
 
235
          xtes = xmp0(icla)*xnp
 
236
 
 
237
          if ( xtes.gt.epsicp .and. x2.gt.epsicp*100.d0 ) then
 
238
            eh0(icel) = xch /x2 * ehsoli(ich(ichcor(icla) ),i  )  &
 
239
                      + xck /x2 * ehsoli(ick(ichcor(icla) ),i  )  &
 
240
                      + xash/x2 * ehsoli(iash(ichcor(icla)),i  )  &
 
241
                      + xwat/x2 * ehsoli(iwat(ichcor(icla)),i  )
 
242
 
 
243
            eh1(icel) = xch /x2 * ehsoli(ich(ichcor(icla) ),i+1)  &
 
244
                      + xck /x2 * ehsoli(ick(ichcor(icla) ),i+1)  &
 
245
                      + xash/x2 * ehsoli(iash(ichcor(icla)),i+1)  &
 
246
                      + xwat/x2 * ehsoli(iwat(ichcor(icla)),i+1)
 
247
 
 
248
            if ( h2.ge.eh0(icel) .and. h2.le.eh1(icel) ) then
 
249
              propce(icel,ipcte2) = thc(i) + (h2-eh0(icel)) *     &
 
250
                    (thc(i+1)-thc(i))/(eh1(icel)-eh0(icel))
 
251
            endif
 
252
          endif
 
253
 
 
254
        endif
 
255
 
 
256
      enddo
 
257
    enddo
 
258
 
 
259
  enddo
 
260
 
 
261
endif
 
262
 
 
263
!===============================================================================
 
264
! Deallocation dynamic arrays
 
265
!----
 
266
deallocate(eh0,eh1,STAT=iok1)
 
267
!----
 
268
if ( iok1 > 0 ) then
 
269
  write(nfecra,*) ' Memory deallocation error inside: '
 
270
  write(nfecra,*) '    cs_coal_thfieldconv2           '
 
271
  call csexit(1)
 
272
endif
 
273
!===============================================================================
 
274
 
 
275
!----
 
276
! End
 
277
!----
 
278
 
 
279
return
 
280
end subroutine