← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/base/ledgeo.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/ledgeo.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 ledgeo &
29
 
!================
30
 
 
31
 
     ( ndim   , ncelet , ncel   , nfac   , nfabor ,               &
32
 
       nprfml , nfml   , nsom   , lndfac , lndfbr )
33
 
 
34
 
!===============================================================================
35
 
! FONCTION :
36
 
! ---------
37
 
 
38
 
! LECTURE DES DIMENSIONS DES TABLEAUX ENTITES GEOMETRIQUES
39
 
 
40
 
!-------------------------------------------------------------------------------
41
 
!ARGU                             ARGUMENTS
42
 
!__________________.____._____.________________________________________________.
43
 
! name             !type!mode ! role                                           !
44
 
!__________________!____!_____!________________________________________________!
45
 
! ndim             ! e  ! --> ! dimension de l'espace (=3)                     !
46
 
! ncelet           ! e  ! --> ! nombre d'elements halo compris                 !
47
 
! ncel             ! e  ! --> ! nombre d'elements actifs                       !
48
 
! nfac             ! e  ! --> ! nombre de faces internes                       !
49
 
! nfabor           ! e  ! --> ! nombre de faces de bord                        !
50
 
! nprfml           ! e  ! --> ! nombre de propietes des familles               !
51
 
!                  !    !     ! de faces de bord                               !
52
 
! nfml             ! e  ! --> ! nombre de familles de faces de bord            !
53
 
! nsom             ! e  ! --> ! nombre de sommets du maillage                  !
54
 
! lndfac           ! e  ! --> ! longueur du tableau nodfac (optionnel          !
55
 
! lndfbr           ! e  ! --> ! longueur du tableau nodfbr (optionnel          !
56
 
!__________________!____!_____!________________________________________________!
57
 
 
58
 
!     TYPE : E (ENTIER), R (REEL), A (ALPHANUMERIQUE), T (TABLEAU)
59
 
!            L (LOGIQUE)   .. ET TYPES COMPOSES (EX : TR TABLEAU REEL)
60
 
!     MODE : <-- donnee, --> resultat, <-> Donnee modifiee
61
 
!            --- tableau de travail
62
 
!===============================================================================
63
 
 
64
 
implicit none
65
 
 
66
 
!===============================================================================
67
 
! Common blocks
68
 
!===============================================================================
69
 
 
70
 
include "paramx.h"
71
 
include "entsor.h"
72
 
 
73
 
!===============================================================================
74
 
 
75
 
! Arguments
76
 
 
77
 
integer          ndim   , ncelet , ncel   , nfac   , nfabor
78
 
integer          nprfml , nfml   , nsom   , lndfac , lndfbr
79
 
 
80
 
! Local variables
81
 
 
82
 
integer          iel , ifac , ifml , nn , n1 , ip
83
 
integer          ntetra , npyram , nprism , nhexae
84
 
 
85
 
!===============================================================================
86
 
 
87
 
ndim = 0
88
 
ncel = 0
89
 
nfac = 0
90
 
nfabor = 0
91
 
nprfml = 0
92
 
nfml   = 0
93
 
nsom   = 0
94
 
 
95
 
lndfac = 0
96
 
lndfbr = 0
97
 
 
98
 
!===============================================================================
99
 
! 1.  Ouverture de FICGEO et lecture des entetes principales
100
 
!===============================================================================
101
 
 
102
 
!---> Ouverture
103
 
 
104
 
OPEN (FILE=FICGEO,UNIT=IMPGEO,FORM='formatted',ERR=9000)
105
 
 
106
 
!---> Ecriture avec rubrique ... avant
107
 
 
108
 
ndim = 3
109
 
 
110
 
read (impgeo,   *,err=9002,end=9003)
111
 
read (impgeo,   *,err=9002,end=9003)
112
 
read (impgeo,1100,err=9002,end=9003) ncel, nfac, nfabor, nsom
113
 
 
114
 
read (impgeo,   *,err=9002,end=9003)
115
 
read (impgeo,   *,err=9002,end=9003)
116
 
read (impgeo,1100,err=9002,end=9003) ntetra,npyram,nprism,nhexae
117
 
 
118
 
read (impgeo,   *,err=9002,end=9003)
119
 
read (impgeo,   *,err=9002,end=9003)
120
 
read (impgeo,1100,err=9002,end=9003) nprfml, nfml
121
 
 
122
 
!===============================================================================
123
 
! 2.  Positionnement dans FICGEO pour la lecture des tableaux optionnels
124
 
!     de connectivites faces sommets (IPNFAC, IPNFBR, NODFAC, NODFBR)
125
 
!===============================================================================
126
 
 
127
 
!-->  Positionnement dans le fichier avant lecture
128
 
 
129
 
!     Connectivite faces internes - cellules
130
 
read(impgeo,*)
131
 
read(impgeo,*)
132
 
do ifac = 1,nfac
133
 
  read(impgeo,*)
134
 
enddo
135
 
 
136
 
!     Connectivite faces de bord - cellule
137
 
read(impgeo,*)
138
 
read(impgeo,*)
139
 
do ifac = 1, nfabor
140
 
  read(impgeo,*)
141
 
enddo
142
 
 
143
 
!     Coordonnees du centre des cellules
144
 
read(impgeo,*)
145
 
read(impgeo,*)
146
 
do iel = 1,ncel
147
 
  read(impgeo,*)
148
 
enddo
149
 
 
150
 
!     Surfaces des faces internes
151
 
read(impgeo,*)
152
 
read(impgeo,*)
153
 
do ifac = 1,nfac
154
 
  read(impgeo,*)
155
 
enddo
156
 
 
157
 
!     Surfaces des faces de bord
158
 
read(impgeo,*)
159
 
read(impgeo,*)
160
 
do ifac = 1,nfabor
161
 
  read(impgeo,*)
162
 
enddo
163
 
 
164
 
!     Coordonnees du centre des faces
165
 
read(impgeo,*)
166
 
read(impgeo,*)
167
 
do ifac = 1,nfac
168
 
  read(impgeo,*)
169
 
enddo
170
 
 
171
 
!     Coordonnees du centre des faces de bord
172
 
read(impgeo,*)
173
 
read(impgeo,*)
174
 
do ifac = 1,nfabor
175
 
  read(impgeo,*)
176
 
enddo
177
 
 
178
 
!     Familles des faces de bord
179
 
read(impgeo,*)
180
 
read(impgeo,*)
181
 
do ifac = 1,nfabor
182
 
  read(impgeo,*)
183
 
enddo
184
 
 
185
 
!     Proprietes des familles
186
 
read(impgeo,*)
187
 
read(impgeo,*)
188
 
do ifml = 1,nfml
189
 
  read(impgeo,*)
190
 
enddo
191
 
 
192
 
!     Coordonnees des noeuds
193
 
read(impgeo,*)
194
 
read(impgeo,*)
195
 
do n1 = 1,nsom
196
 
  read(impgeo,*)
197
 
enddo
198
 
 
199
 
!     Connectivite cellules points
200
 
read(impgeo,*)
201
 
read(impgeo,*)
202
 
do n1 = 1,ncel
203
 
  read(impgeo,*)
204
 
enddo
205
 
 
206
 
!===============================================================================
207
 
! 3.  Calcul des dimensions LNDFAC et LNDFBR si possible
208
 
!===============================================================================
209
 
 
210
 
!     Remarque : si les tableaux ne sont pas disponibles,
211
 
!                on aura une erreur de fin de fichier.
212
 
!                Dans ce cas, on sort en fermant normalement
213
 
!                le fichier, en mettant LNDFAC et LNDFBR � 0.
214
 
 
215
 
!-->  Dimension du tableau de connectivite faces de bord -> points
216
 
 
217
 
read(impgeo,*,err=9000,end=100)
218
 
read(impgeo,*,err=9000,end=100)
219
 
lndfbr = 0
220
 
do n1 = 1,nfabor
221
 
  read(impgeo,1200,err=9000,end=100) nn , ip
222
 
  lndfbr = lndfbr + ip
223
 
enddo
224
 
 
225
 
!-->  Dimension du tableau de connectivite faces internes -> points
226
 
 
227
 
read(impgeo,*,err=9000,end=100)
228
 
read(impgeo,*,err=9000,end=100)
229
 
lndfac = 0
230
 
do n1 = 1,nfac
231
 
  read(impgeo,1200,err=9000,end=100) nn , ip
232
 
  lndfac = lndfac + ip
233
 
enddo
234
 
 
235
 
!-->  Si l'on a pu lire les tableaux de connectivite faces -> points,
236
 
!     on conserve les dimensions LNDFBR et LNDFAC calculees ;
237
 
!     sinon, on les remet a zero
238
 
 
239
 
goto 200
240
 
 
241
 
 100  lndfbr = 0
242
 
lndfac = 0
243
 
 
244
 
 200  continue
245
 
 
246
 
!===============================================================================
247
 
! 3.  Fermeture du fichier et mise a jour des structures C
248
 
!===============================================================================
249
 
 
250
 
close(impgeo)
251
 
 
252
 
!---> MISE A JOUR STRUCTURES C
253
 
 
254
 
ncelet = ncel
255
 
 
256
 
call dimgeo                                                       &
257
 
!==========
258
 
     (ndim  , ncelet, ncel  , nfac  , nfabor , nsom  ,            &
259
 
      lndfac, lndfbr, nfml  , nprfml,                             &
260
 
      ntetra, npyram, nprism, nhexae)
261
 
 
262
 
!---> FORMATS
263
 
 
264
 
 1100 format(20i10)
265
 
 1200 format(i10,i10)
266
 
 
267
 
return
268
 
 
269
 
! ERREURS
270
 
 
271
 
 9000 continue
272
 
write(nfecra,8000)ficgeo
273
 
call csexit (1)
274
 
 9002 continue
275
 
write(nfecra,8002)                                                &
276
 
            ficgeo,ndim,ncel,nfac,nfabor,nprfml,nfml  ,nsom
277
 
call csexit (1)
278
 
 9003 continue
279
 
write(nfecra,8003)                                                &
280
 
            ficgeo,ndim,ncel,nfac,nfabor,nprfml,nfml  ,nsom
281
 
call csexit (1)
282
 
 
283
 
! FORMATS
284
 
 
285
 
#if defined(_CS_LANG_FR)
286
 
 
287
 
 8000 format(                                                           &
288
 
'@                                                            ',/,&
289
 
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
290
 
'@                                                            ',/,&
291
 
'@ @@ ATTENTION : ARRET A L''OUVERTURE DU FICHIER GEOMETRIE   ',/,&
292
 
'@    =========                                               ',/,&
293
 
'@      ERREUR DANS ledgeo POUR LE FICHIER ',A6                ,/,&
294
 
'@                                                            ',/,&
295
 
'@      Le calcul ne peut etre execute.                       ',/,&
296
 
'@                                                            ',/,&
297
 
'@      Verifier le fichier geometrie (existence, droits      ',/,&
298
 
'@        d''acces, recopie correcte dans le repertoire de    ',/,&
299
 
'@        travail).                                           ',/,&
300
 
'@                                                            ',/,&
301
 
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
302
 
'@                                                            ',/)
303
 
 8002 format(                                                           &
304
 
'@                                                            ',/,&
305
 
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
306
 
'@                                                            ',/,&
307
 
'@ @@ ATTENTION : ARRET A LA LECTURE DU FICHIER GEOMETRIE     ',/,&
308
 
'@    =========                                               ',/,&
309
 
'@      ERREUR DANS ledgeo POUR LE FICHIER ',A6                ,/,&
310
 
'@                                                            ',/,&
311
 
'@      L''etat des dimensions lues est le suivant :          ',/,&
312
 
'@        NDIM      NCEL      NFAC    NFABOR                  ',/,&
313
 
'@  ',4I10                                                     ,/,&
314
 
'@        NPRFML    NFML      NSOM                            ',/,&
315
 
'@  ',3I10                                                     ,/,&
316
 
'@                                                            ',/,&
317
 
'@      Le calcul ne peut etre execute.                       ',/,&
318
 
'@                                                            ',/,&
319
 
'@      Verifier le fichier geometrie (existence, droits      ',/,&
320
 
'@        d''acces, format...).                               ',/,&
321
 
'@                                                            ',/,&
322
 
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
323
 
'@                                                            ',/)
324
 
 8003 format(                                                           &
325
 
'@                                                            ',/,&
326
 
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
327
 
'@                                                            ',/,&
328
 
'@ @@ ATTENTION : ARRET A LA LECTURE DU FICHIER GEOMETRIE     ',/,&
329
 
'@    =========                                               ',/,&
330
 
'@      FIN PREMATUREE DANS ledgeo POUR LE FICHIER ',A6        ,/,&
331
 
'@                                                            ',/,&
332
 
'@      L''etat des dimensions lues est le suivant :          ',/,&
333
 
'@        NDIM      NCEL      NFAC    NFABOR                  ',/,&
334
 
'@  ',4I10                                                     ,/,&
335
 
'@        NPRFML    NFML      NSOM                            ',/,&
336
 
'@  ',3I10                                                     ,/,&
337
 
'@                                                            ',/,&
338
 
'@      Le calcul ne peut etre execute.                       ',/,&
339
 
'@                                                            ',/,&
340
 
'@      Verifier le fichier geometrie (existence, droits      ',/,&
341
 
'@        d''acces, format...).                               ',/,&
342
 
'@                                                            ',/,&
343
 
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
344
 
'@                                                            ',/)
345
 
 
346
 
#else
347
 
 
348
 
 8000 format(                                                           &
349
 
'@                                                            ',/,&
350
 
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
351
 
'@                                                            ',/,&
352
 
'@ @@ WARNING: ABORT WHILE OPENING THE GEOMETRY FILE          ',/,&
353
 
'@    ========                                                ',/,&
354
 
'@      ERROR IN ledgeo FOR FILE ',A6                          ,/,&
355
 
'@                                                            ',/,&
356
 
'@      The calculation will not be run.                      ',/,&
357
 
'@                                                            ',/,&
358
 
'@      Verify the geometry file (existence, access           ',/,&
359
 
'@        permission, correct copy in the working directory)  ',/,&
360
 
'@                                                            ',/,&
361
 
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
362
 
'@                                                            ',/)
363
 
 8002 format(                                                           &
364
 
'@                                                            ',/,&
365
 
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
366
 
'@                                                            ',/,&
367
 
'@ @@ WARNING: ABORT WHILE READING THE GEOMETRY FILE          ',/,&
368
 
'@    ========                                                ',/,&
369
 
'@      ERROR IN ledgeo FOR FILE ',A6                          ,/,&
370
 
'@                                                            ',/,&
371
 
'@      The state of the read dimensions is:                  ',/,&
372
 
'@        NDIM      NCEL      NFAC    NFABOR                  ',/,&
373
 
'@  ',4I10                                                     ,/,&
374
 
'@        NPRFML    NFML      NSOM                            ',/,&
375
 
'@  ',3I10                                                     ,/,&
376
 
'@                                                            ',/,&
377
 
'@      The calculation will not be run.                      ',/,&
378
 
'@                                                            ',/,&
379
 
'@      Verify the geometry file (existence, access           ',/,&
380
 
'@        permission, format...)                              ',/,&
381
 
'@                                                            ',/,&
382
 
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
383
 
'@                                                            ',/)
384
 
 8003 format(                                                           &
385
 
'@                                                            ',/,&
386
 
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
387
 
'@                                                            ',/,&
388
 
'@ @@ WARNING: ABORT WHILE READING THE GEOMETRY FILE          ',/,&
389
 
'@    ========                                                ',/,&
390
 
'@      UNEXPECTED END OF FILE in ledgeo FOR FILE ',A6         ,/,&
391
 
'@                                                            ',/,&
392
 
'@      The state of the read dimensions is:                  ',/,&
393
 
'@        NDIM      NCEL      NFAC    NFABOR                  ',/,&
394
 
'@  ',4I10                                                     ,/,&
395
 
'@        NPRFML    NFML      NSOM                            ',/,&
396
 
'@  ',3I10                                                     ,/,&
397
 
'@                                                            ',/,&
398
 
'@      The calculation will not be run.                      ',/,&
399
 
'@                                                            ',/,&
400
 
'@      Verify the geometry file (existence, access           ',/,&
401
 
'@        permission, format...)                              ',/,&
402
 
'@                                                            ',/,&
403
 
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@',/,&
404
 
'@                                                            ',/)
405
 
 
406
 
#endif
407
 
 
408
 
end subroutine