← Back to branch summary

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

« back to all changes in this revision

Viewing changes to users/base/uspt1d.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:
users/base/uspt1d.f90
2
2
 
3
3
!VERS
4
4
 
5
 
 
6
 
!     This file is part of the Code_Saturne Kernel, element of the
7
 
!     Code_Saturne CFD tool.
8
 
 
9
 
!     Copyright (C) 1998-2009 EDF S.A., France
10
 
 
11
 
!     contact: saturne-support@edf.fr
12
 
 
13
 
!     The Code_Saturne Kernel is free software; you can redistribute it
14
 
!     and/or modify it under the terms of the GNU General Public License
15
 
!     as published by the Free Software Foundation; either version 2 of
16
 
!     the License, or (at your option) any later version.
17
 
 
18
 
!     The Code_Saturne Kernel is distributed in the hope that it will be
19
 
!     useful, but WITHOUT ANY WARRANTY; without even the implied warranty
20
 
!     of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
21
 
!     GNU General Public License for more details.
22
 
 
23
 
!     You should have received a copy of the GNU General Public License
24
 
!     along with the Code_Saturne Kernel; if not, write to the
25
 
!     Free Software Foundation, Inc.,
26
 
!     51 Franklin St, Fifth Floor,
27
 
!     Boston, MA  02110-1301  USA
 
5
! This file is part of Code_Saturne, a general-purpose CFD tool.
 
6
!
 
7
! Copyright (C) 1998-2011 EDF S.A.
 
8
!
 
9
! This program is free software; you can redistribute it and/or modify it under
 
10
! the terms of the GNU General Public License as published by the Free Software
 
11
! Foundation; either version 2 of the License, or (at your option) any later
 
12
! version.
 
13
!
 
14
! This program is distributed in the hope that it will be useful, but WITHOUT
 
15
! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
 
16
! FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
 
17
! details.
 
18
!
 
19
! You should have received a copy of the GNU General Public License along with
 
20
! this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
 
21
! Street, Fifth Floor, Boston, MA 02110-1301, USA.
28
22
 
29
23
!-------------------------------------------------------------------------------
30
24
 
31
25
subroutine uspt1d &
32
26
!================
33
27
 
34
 
 ( idbia0 , idbra0 ,                                              &
35
 
   ndim   , ncelet , ncel   , nfac   , nfabor , nfml   , nprfml , &
36
 
   nnod   , lndfac , lndfbr , ncelbr ,                            &
37
 
   nvar   , nscal  , nphas  , nfpt1d , iphas  , iappel ,          &
38
 
   nideve , nrdeve , nituse , nrtuse ,                            &
39
 
   ifacel , ifabor , ifmfbr , ifmcel , iprfml , maxelt , lstelt , &
40
 
   ipnfac , nodfac , ipnfbr , nodfbr ,                            &
41
 
   ifpt1d , nppt1d , iclt1d ,                                     &
42
 
   idevel , ituser , ia     ,                                     &
43
 
   xyzcen , surfac , surfbo , cdgfac , cdgfbo ,                   &
44
 
   xyznod , volume ,                                              &
 
28
 ( nvar   , nscal  , nfpt1d , iappel ,                            &
 
29
   ifpt1d , izft1d , nppt1d , iclt1d ,                            &
45
30
   tppt1d , rgpt1d , eppt1d ,                                     &
46
31
   tept1d , hept1d , fept1d ,                                     &
47
32
   xlmt1d , rcpt1d , dtpt1d ,                                     &
48
33
   dt     , rtpa   ,                                              &
49
34
   propce , propfa , propfb ,                                     &
50
 
   coefa  , coefb  ,                                              &
51
 
   rdevel , rtuser , ra     )
 
35
   coefa  , coefb  )
52
36
 
53
37
!===============================================================================
54
38
! Purpose:
56
40
 
57
41
!     User subroutine.
58
42
 
59
 
!     Data Entry ot the thermic module in 1-Dimension Wall.
 
43
!     Data Entry ot the thermal module in 1-Dimension Wall.
60
44
 
61
45
 
62
46
! Introduction:
66
50
!--------------------------------------------------------
67
51
 
68
52
! iappel = 1 (only one call on initialization):
69
 
!            Computation of the cells number where we impose a wall
 
53
!            Computation of the cells number where we prescribe a wall
70
54
 
71
55
! iappel = 2 (only one call on initialization):
72
 
!            Locating cells where we impose a wall
 
56
!            Locating cells where we prescribe a wall
73
57
!            Data linked to the meshing.
74
58
 
75
59
! iappel = 3 (call on each time step):
77
61
!            boundary condition type on the exterior wall:
78
62
!            --------------------------------------------
79
63
!
80
 
!             iclt1d = 1 -> constant temperature imposed
81
 
!             iclt1d = 3 -> heat flux imposed
 
64
!             iclt1d = 1 -> constant temperature prescribed
 
65
!             iclt1d = 3 -> heat flux prescribed
82
66
 
83
67
!            Initialization of the temperature on the wall.
84
68
 
95
79
!__________________.____._____.________________________________________________.
96
80
! name             !type!mode ! role                                           !
97
81
!__________________!____!_____!________________________________________________!
98
 
! idbia0           ! i  ! <-- ! number of first free position in ia            !
99
 
! idbra0           ! i  ! <-- ! number of first free position in ra            !
100
 
! ndim             ! i  ! <-- ! spatial dimension                              !
101
 
! ncelet           ! i  ! <-- ! number of extended (real + ghost) cells        !
102
 
! ncel             ! i  ! <-- ! number of cells                                !
103
 
! nfac             ! i  ! <-- ! number of interior faces                       !
104
 
! nfabor           ! i  ! <-- ! number of boundary faces                       !
105
 
! nfml             ! i  ! <-- ! number of families (group classes)             !
106
 
! nprfml           ! i  ! <-- ! number of properties per family (group class)  !
107
 
! nnod             ! i  ! <-- ! number of vertices                             !
108
 
! lndfac           ! i  ! <-- ! size of nodfac indexed array                   !
109
 
! lndfbr           ! i  ! <-- ! size of nodfbr indexed array                   !
110
 
! ncelbr           ! i  ! <-- ! number of cells with faces on boundary         !
111
82
! nvar             ! i  ! <-- ! total number of variables                      !
112
83
! nscal            ! i  ! <-- ! total number of scalars                        !
113
 
! nphas            ! i  ! <-- ! number of phases                               !
114
 
! nfpt1d           ! i  ! <-- ! number of faces with the 1-D thermic module    !
115
 
! nideve, nrdeve   ! i  ! <-- ! sizes of idevel and rdevel arrays              !
116
 
! nituse, nrtuse   ! i  ! <-- ! sizes of ituser and rtuser arrays              !
 
84
! nfpt1d           ! i  ! <-- ! number of faces with the 1-D thermal module    !
117
85
! iappel           ! i  ! <-- ! data type to send                              !
118
 
! ifacel(2, nfac)  ! ia ! <-- ! interior faces -> cells connectivity           !
119
 
! ifabor(nfabor)   ! ia ! <-- ! boundary faces -> cells connectivity           !
120
 
! ifmfbr(nfabor)   ! ia ! <-- ! boundary face family numbers                   !
121
 
! ifmcel(ncelet)   ! ia ! <-- ! cell family numbers                            !
122
 
! iprfml           ! ia ! <-- ! property numbers per family                    !
123
 
!  (nfml, nprfml)  !    !     !                                                !
124
 
! maxelt           !  i ! <-- ! max number of cells and faces (int/boundary)   !
125
 
! lstelt(maxelt)   ! ia ! --- ! work array                                     !
126
86
! ifpt1d           ! ia ! <-- ! number of the face treated                     !
 
87
! izft1d           ! ia ! <-- ! boundary faces zone for 1d-module definition   !
127
88
! nppt1d           ! ia ! <-- ! number of discretized points                   !
128
89
! iclt1d           ! ia ! <-- ! boundary condition type                        !
129
 
!--begin. obsolesence ---------------------------------------------------------!
130
 
! ipnfac(nfac+1)   ! ia ! <-- ! interior faces -> vertices index (optional)    !
131
 
! nodfac(lndfac)   ! ia ! <-- ! interior faces -> vertices list (optional)     !
132
 
! ipnfbr(nfabor+1) ! ia ! <-- ! boundary faces -> vertices index (optional)    !
133
 
! nodfac(lndfbr)   ! ia ! <-- ! boundary faces -> vertices list (optional)     !
134
 
!--end obsolesence ------------------------------------------------------------!
135
 
! idevel(nideve)   ! ia ! <-- ! integer work array for temporary developpement !
136
 
! ituser(nituse)   ! ia ! <-- ! user-reserved integer work array               !
137
 
! ia(*)            ! ia ! --- ! main integer work array                        !
138
 
!--new ------------------------------------------------------------------------!
139
 
! eppt1d           ! ra ! <-- ! wall thickness                                 !<--new
140
 
! rgpt1d           ! ra ! <-- ! geometric ratio of the meshing refinement      !<--new
141
 
! tppt1d           ! ra ! <-- ! wall temperature initialization                !<--new
142
 
! tept1d           ! ra ! <-- ! exterior temperature                           !<--new
143
 
! hept1d           ! ra ! <-- ! exterior exchange coefficient                  !<--new
144
 
! fept1d           ! ra ! <-- ! flux applied to the exterior                   !<--new
145
 
! xlmt1d           ! ra ! <-- ! lambda wall conductivity coefficient           !<--new
146
 
! rcpt1d           ! ra ! <-- ! rhoCp wall coefficient                         !<--new
147
 
! dtpt1d           ! ra ! <-- ! wall time step                                 !<--new
148
 
!--begin. obsolesence ---------------------------------------------------------!--!
149
 
! xyzcen           ! ra ! <-- ! cell centers                                   !  !
150
 
!  (ndim, ncelet)  !    !     !                                                !  !
151
 
! surfac           ! ra ! <-- ! interior faces surface vectors                 !  !
152
 
!  (ndim, nfac)    !    !     !                                                !  !
153
 
! surfbo           ! ra ! <-- ! boundary faces surface vectors                 !  !
154
 
!  (ndim, nfavor)  !    !     !                                                !  !
155
 
! cdgfac           ! ra ! <-- ! interior faces centers of gravity              !  !
156
 
!  (ndim, nfac)    !    !     !                                                !  !
157
 
! cdgfbo           ! ra ! <-- ! boundary faces centers of gravity              !  !
158
 
!  (ndim, nfabor)  !    !     !                                                !  !
159
 
! xyznod           ! ra ! <-- ! vertex coordinates (optional)                  !  !
160
 
!  (ndim, nnod)    !    !     !                                                !  !
161
 
! volume(ncelet)   ! ra ! <-- ! cell volumes                                   !  !
162
 
! dt(ncelet)       ! ra ! <-- ! time step (per cell)                           !  !
163
 
! rtp, rtpa        ! ra ! <-- ! calculated variables at cell centers           !  !
164
 
!  (ncelet, *)     !    !     !  (at current and preceding time steps)         !  !
165
 
! propce(ncelet, *)! ra ! <-- ! physical properties at cell centers            !  !
166
 
! propfa(nfac, *)  ! ra ! <-- ! physical properties at interior face centers   !  !
167
 
! propfb(nfabor, *)! ra ! <-- ! physical properties at boundary face centers   !  !
168
 
! coefa, coefb     ! ra ! <-- ! boundary conditions                            !  !
169
 
!  (nfabor, *)     !    !     !                                                !  !
170
 
! coefu            ! ra ! --- ! work array                                     !  !
171
 
!  (nfabor, 3)     !    !     !  (computation of pressure gradient)            !  !
172
 
!-end obsolesence--------------------------------------------------------------!--!
173
 
! rdevel(nrdeve)   ! ra ! <-> ! real work array for temporary developpement    !
174
 
! rtuser(nituse    ! ra ! <-- ! user-reserved real work array                  !
175
 
! ra(*)            ! ra ! --- ! main real work array                           !
 
90
! eppt1d           ! ra ! <-- ! wall thickness                                 !
 
91
! rgpt1d           ! ra ! <-- ! geometric ratio of the meshing refinement      !
 
92
! tppt1d           ! ra ! <-- ! wall temperature initialization                !
 
93
! tept1d           ! ra ! <-- ! exterior temperature                           !
 
94
! hept1d           ! ra ! <-- ! exterior exchange coefficient                  !
 
95
! fept1d           ! ra ! <-- ! flux applied to the exterior                   !
 
96
! xlmt1d           ! ra ! <-- ! lambda wall conductivity coefficient           !
 
97
! rcpt1d           ! ra ! <-- ! rhoCp wall coefficient                         !
 
98
! dtpt1d           ! ra ! <-- ! wall time step                                 !
 
99
! dt(ncelet)       ! ra ! <-- ! time step (per cell)                           !
 
100
! rtp, rtpa        ! ra ! <-- ! calculated variables at cell centers           !
 
101
!  (ncelet, *)     !    !     !  (at current and preceding time steps)         !
 
102
! propce(ncelet, *)! ra ! <-- ! physical properties at cell centers            !
 
103
! propfa(nfac, *)  ! ra ! <-- ! physical properties at interior face centers   !
 
104
! propfb(nfabor, *)! ra ! <-- ! physical properties at boundary face centers   !
 
105
! coefa, coefb     ! ra ! <-- ! boundary conditions                            !
 
106
!  (nfabor, *)     !    !     !                                                !
176
107
!__________________!____!_____!________________________________________________!
177
108
 
178
109
!     Type: i (integer), r (real), s (string), a (array), l (logical),
181
112
!===============================================================================
182
113
 
183
114
!===============================================================================
 
115
! Data in common
 
116
!===============================================================================
 
117
 
 
118
use paramx
 
119
use numvar
 
120
use entsor
 
121
use optcal
 
122
use cstphy
 
123
use cstnum
 
124
use parall
 
125
use period
 
126
use mesh
 
127
 
 
128
!===============================================================================
184
129
 
185
130
implicit none
186
131
 
187
 
!===============================================================================
188
 
! Data in common
189
 
!===============================================================================
190
 
 
191
 
include "paramx.h"
192
 
include "numvar.h"
193
 
include "entsor.h"
194
 
include "optcal.h"
195
 
include "cstphy.h"
196
 
include "cstnum.h"
197
 
include "parall.h"
198
 
include "period.h"
199
 
 
200
 
!===============================================================================
201
 
 
202
132
! Arguments
203
 
!-------------------------------------------------------------------
204
 
integer          idbia0 , idbra0
205
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
206
 
integer          nfml   , nprfml
207
 
integer          nnod   , lndfac , lndfbr , ncelbr
208
 
integer          nvar   , nscal  , nphas  , nfpt1d
209
 
integer          nideve , nrdeve , nituse , nrtuse
210
 
integer          iphas  , iappel
211
 
 
212
 
integer          ifacel(2,nfac) , ifabor(nfabor)
213
 
integer          ifmfbr(nfabor) , ifmcel(ncelet)
214
 
integer          iprfml(nfml,nprfml)
215
 
integer          maxelt, lstelt(maxelt)
216
 
integer          ipnfac(nfac+1), nodfac(lndfac)
217
 
integer          ipnfbr(nfabor+1), nodfbr(lndfbr)
 
133
 
 
134
integer          nvar   , nscal  , nfpt1d
 
135
integer          iappel
 
136
 
218
137
integer          ifpt1d(nfpt1d), nppt1d(nfpt1d), iclt1d(nfpt1d)
219
 
integer          idevel(nideve), ituser(nituse), ia(*)
 
138
integer          izft1d(nfabor)
220
139
 
221
 
double precision xyzcen(ndim,ncelet)
222
 
double precision surfac(ndim,nfac), surfbo(ndim,nfabor)
223
 
double precision cdgfac(ndim,nfac), cdgfbo(ndim,nfabor)
224
 
double precision xyznod(ndim,nnod), volume(ncelet)
225
140
double precision dt(ncelet), rtpa(ncelet,*)
226
141
double precision propce(ncelet,*)
227
142
double precision propfa(nfac,*), propfb(nfabor,*)
229
144
double precision eppt1d(nfpt1d) , rgpt1d(nfpt1d) , tppt1d(nfpt1d)
230
145
double precision tept1d(nfpt1d) , hept1d(nfpt1d) , fept1d(nfpt1d)
231
146
double precision xlmt1d(nfpt1d) , rcpt1d(nfpt1d) , dtpt1d(nfpt1d)
232
 
double precision rdevel(nrdeve), rtuser(nrtuse), ra(*)
233
147
 
234
148
! Local variables
235
 
!-------------------------------------------------------------------
236
 
integer          idebia , idebra
 
149
 
237
150
integer          ifbt1d , ii , ifac
238
151
integer          ilelt, nlelt
 
152
integer          izone
 
153
 
 
154
integer, allocatable, dimension(:) :: lstelt
239
155
 
240
156
!===============================================================================
241
157
 
242
 
idebia = idbia0
243
 
idebra = idbra0
244
 
 
 
158
! Allocate a temporary array for boundary faces selection
 
159
allocate(lstelt(nfabor))
245
160
 
246
161
!===============================================================================
247
162
! Rereading of the restart file:
250
165
!     isuit1 = 0        --> No rereading
251
166
!                           (meshing and wall temperature reinitialization)
252
167
!     isuit1 = 1        --> Rereading of the restart file for the 1-Dimension
253
 
!                           thermic module
 
168
!                           thermal module
254
169
!     isuit1 = isuite   --> Rereading only if the computational fluid dynamic is
255
170
!                           a continuation of the computation.
256
171
 
259
174
 
260
175
isuit1 = isuite
261
176
 
 
177
izone = 0
262
178
ifbt1d = 0
263
179
 
264
180
! TEST_TO_REMOVE_FOR_USE_OF_SUBROUTINE_START
265
181
!===============================================================================
266
 
if(1.eq.1) return
 
182
if (1.eq.1) return
267
183
!===============================================================================
268
184
! TEST_TO_REMOVE_FOR_USE_OF_SUBROUTINE_END
269
185
 
270
 
if(iappel.eq.1.or.iappel.eq.2) then
 
186
if (iappel.eq.1.or.iappel.eq.2) then
271
187
 
272
188
!===============================================================================
273
 
! Faces determining with the 1-D thermic module:
 
189
! Faces determining with the 1-D thermal module:
274
190
!----------------------------------------------
275
191
!
276
 
!     nfpt1d    : Total number of faces with the 1-D thermic module
277
 
!     ifpt1d(ii): Number of the (ii)th face with the 1-D thermic module
 
192
!     nfpt1d    : Total number of faces with the 1-D thermal module
 
193
!     ifpt1d(ii): Number of the (ii)th face with the 1-D thermal module
278
194
 
279
195
! Remarks:
280
196
!--------
283
199
!     the start or restarting computation.
284
200
!
285
201
!     A total similarity is required to continue with the previous computation.
286
 
!     Regarding the test case on ifpt1d, it is necessary that the array will be
287
 
!     arranged in increasing order
288
 
!               (as following : ifpt1d(jj) > ifpt1d(ii) si jj > ii).
 
202
!     Regarding the test case on ifpt1d, it is necessary that the array be
 
203
!     arranged in increasing order (ifpt1d(jj) > ifpt1d(ii) if jj > ii).
289
204
!
290
205
!     If it is impossible, contact the developer team to deactivate this test.
291
206
!===============================================================================
292
207
 
293
 
  CALL GETFBR('3',NLELT,LSTELT)
 
208
  call getfbr('3', nlelt, lstelt)
294
209
  !==========
295
210
 
 
211
  izone = izone + 1
 
212
 
296
213
  do ilelt = 1, nlelt
297
214
 
298
215
    ifac = lstelt(ilelt)
299
 
 
 
216
    izft1d(ifac) = izone
300
217
    ifbt1d =ifbt1d + 1
301
218
    if (iappel.eq.2) ifpt1d(ifbt1d) = ifac
302
219
 
305
222
endif
306
223
 
307
224
if (iappel.eq.1) then
308
 
   nfpt1d = ifbt1d
 
225
  nfpt1d = ifbt1d
309
226
endif
310
227
 
311
228
!===============================================================================
315
232
!     (Only one pass during the beginning of the computation)
316
233
 
317
234
!     nppt1d(ii): number of discretized points associated to the (ii)th face
318
 
!                 with the 1-D thermic module.
 
235
!                 with the 1-D thermal module.
319
236
!     eppt1d(ii): wall thickness associated to the (ii)th face
320
 
!                 with the 1-D thermic module.
 
237
!                 with the 1-D thermal module.
321
238
!     rgpt1d(ii): geometric progression ratio of the meshing refinement
322
 
!                 associated to the (ii)th face with the 1-D thermic module.
 
239
!                 associated to the (ii)th face with the 1-D thermal module.
323
240
!                 (with : rgpt1d(ii) > 1 => small meshes  on the fluid side)
324
241
!     tppt1d(ii): wall temperature initialization associated to the (ii)th face
325
 
!                 with the 1-D thermic module.
 
242
!                 with the 1-D thermal module.
326
243
 
327
244
! Remarks:
328
245
!--------
329
 
!     During the rereading of the restart file for the 1-D thermic module,
 
246
!     During the rereading of the restart file for the 1-D thermal module,
330
247
!     the tppt1d variable is not used.
331
248
!
332
249
!     The nfpt1d, eppt1d and rgpt1d variables are compared to the previous
335
252
!     An exact similarity is necessary to continue with the previous computation.
336
253
!===============================================================================
337
254
if (iappel.eq.2) then
338
 
   if(iphas.eq.1) then
339
 
      do ii = 1, nfpt1d
340
 
        ifac = ifpt1d(ii)
341
 
        nppt1d(ii) = 8
342
 
        eppt1d(ii) = 0.01144d0
343
 
        rgpt1d(ii) = 1.d0
344
 
        tppt1d(ii) = 25.d0
345
 
      enddo
346
 
   endif
 
255
  do ii = 1, nfpt1d
 
256
    ifac = ifpt1d(ii)
 
257
    nppt1d(ii) = 8
 
258
    eppt1d(ii) = 0.01144d0
 
259
    rgpt1d(ii) = 1.d0
 
260
    tppt1d(ii) = 25.d0
 
261
  enddo
347
262
endif
348
263
!===============================================================================
349
264
! Padding of the wall exterior boundary conditions:
351
266
!
352
267
!     iclt1d(ii): boundary condition type
353
268
!     ----------
354
 
!                  iclt1d(ii) = 1: dirichlet's condition ,  with exchange coefficient
 
269
!                  iclt1d(ii) = 1: dirichlet condition,
 
270
!                                  with exchange coefficient
355
271
!                  iclt1d(ii) = 3: flux condition
356
272
!
357
273
!     tept1d(ii): exterior temperature
358
274
!     hept1d(ii): exterior exchange coefficient
359
275
!     fept1d(ii): flux applied to the exterior (flux<0 = coming flux)
360
 
!     xlmt1d(ii): lambda wall conductivity coefficient (W/m/�C)
361
 
!     rcpt1d(ii): wall coefficient rho*Cp (J/m3/�C)
362
 
!     dtpt1d(ii): time step resolution of the thermic equation to the
363
 
!                 (ii)th border face with the 1-D thermic module (s)
 
276
!     xlmt1d(ii): lambda wall conductivity coefficient (W/m/C)
 
277
!     rcpt1d(ii): wall coefficient rho*Cp (J/m3/C)
 
278
!     dtpt1d(ii): time step resolution of the thermal equation to the
 
279
!                 (ii)th border face with the 1-D thermal module (s)
364
280
!===============================================================================
365
281
if (iappel.eq.3) then
366
 
   if(iphas.eq.1) then
367
 
      do ii = 1, nfpt1d
368
 
         iclt1d(ii) = 1
369
 
! Physical parameters
370
 
         ifac = ifpt1d(ii)
371
 
         if (cdgfbo(2,ifac).le.0.025d0) then
372
 
           iclt1d(ii) = 3
373
 
           fept1d(ii) = -1.d4
374
 
         else
375
 
           iclt1d(ii) = 3
376
 
           fept1d(ii) =  1.d4
377
 
         endif
378
 
         xlmt1d(ii) = 31.5d0
379
 
         rcpt1d(ii) = 3.5d6
380
 
         dtpt1d(ii) = 0.3d0
381
 
      enddo
382
 
   endif
 
282
  do ii = 1, nfpt1d
 
283
    iclt1d(ii) = 1
 
284
    ! Physical parameters
 
285
    ifac = ifpt1d(ii)
 
286
    if (cdgfbo(2,ifac).le.0.025d0) then
 
287
      iclt1d(ii) = 3
 
288
      fept1d(ii) = -1.d4
 
289
    else
 
290
      iclt1d(ii) = 3
 
291
      fept1d(ii) =  1.d4
 
292
    endif
 
293
    xlmt1d(ii) = 31.5d0
 
294
    rcpt1d(ii) = 3.5d6
 
295
    dtpt1d(ii) = 0.3d0
 
296
  enddo
383
297
endif
384
298
 
385
299
!===============================================================================
386
 
! END of the uspt1d subroutine =====================================================
 
300
! End of the uspt1d subroutine
387
301
!===============================================================================
 
302
 
 
303
! Deallocate the temporary array
 
304
deallocate(lstelt)
 
305
 
388
306
return
389
307
end subroutine
390
308