MED fichier
f/2.3.6/test19.f
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2019 EDF R&D, CEA/DEN
4 C* MED is free software: you can redistribute it and/or modify
5 C* it under the terms of the GNU Lesser General Public License as published by
6 C* the Free Software Foundation, either version 3 of the License, or
7 C* (at your option) any later version.
8 C*
9 C* MED is distributed in the hope that it will be useful,
10 C* but WITHOUT ANY WARRANTY; without even the implied warranty of
11 C* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 C* GNU Lesser General Public License for more details.
13 C*
14 C* You should have received a copy of the GNU Lesser General Public License
15 C* along with MED. If not, see <http://www.gnu.org/licenses/>.
16 C*
17 
18 C******************************************************************************
19 C * - Nom du fichier : test19.f
20 C *
21 C * - Description : conversion groupes => familles
22 C *
23 C *****************************************************************************
24  program test19
25 C
26  implicit none
27  include 'med.hf'
28 C
29 C
30  integer cret
31  integer*8 fid
32 
33  character *32 maa
34  parameter(maa = "maillage_test19")
35  character*200 des
36  parameter(des = "un maillage pour test19")
37  integer mdim
38  parameter(mdim = 2)
39 C Donnees de tests pour MEDgro2FamCr()
40 C Les noeuds/mailles sont numerotes de 1 a 5 et les
41 C groupes de 1 a 3.
42 C Au depart, on a :
43 C - G1 : 1,2
44 C - G2 : 3,4,6
45 C - G3 : 1,4
46 C Au retour, on foit avoir 4 familles de noeuds + 4 familles de mailles
47 C + la famille 0 dans le fichier :
48 C - F0 : 5 - groupes : aucun groupe par defaut (convention habituelle).
49 C - F1 : 1 - groupes : G1,G3
50 C - F2 : 2 - groupes : G1
51 C - F3 : 3,6 - groupes : G2
52 C - F4 : 4 - groupes : G2,G3
53 C
54  integer ngroup
55  parameter(ngroup = 3)
56  integer nent
57  parameter(nent = 6)
58  character*80 nomgro(ngroup)
59  integer ent(7)
60  integer ind(ngroup+1)
61  integer ngeo
62  parameter(ngeo = 3)
63  integer geo(ngeo)
64  integer indgeo(ngeo+1)
65  character*200 attdes,gro
66  integer attval,attide
67  integer typgeo
68  integer indtmp
69 C
70  data nomgro / "GROUPE1","GROUPE2","GROUPE3" /
71  data ent / 1,2, 3,4,6, 1,4 /
72  data ind / 1, 3, 6, 8 /
73  data geo / med_seg2, med_tria3, med_tetra4 /
74  data indgeo / 1,4,6,7 /
75 C
76 C ** Creation du fichier test19.med
77  call efouvr(fid,'test19.med',med_lecture_ecriture, cret)
78  print *,cret
79  if (cret .ne. 0 ) then
80  print *,'Erreur creation du fichier'
81  call efexit(-1)
82  endif
83  print *,'Creation du fichier test19.med'
84 C
85 C ** Creation du maillage
86  call efmaac(fid,maa,mdim,med_non_structure,des,cret)
87  print *,cret
88  if (cret .ne. 0 ) then
89  print *,'Erreur creation du maillage'
90  call efexit(-1)
91  endif
92  print *,'Creation du maillage'
93 C
94 C ** Creation de la famille 0
95  call effamc(fid,maa,'FAMILLE_0',0,attide,attval,attdes,0,gro,0,
96  & cret)
97  print *,cret
98  if (cret .ne. 0 ) then
99  print *,'Erreur creation de la famille 0'
100  call efexit(-1)
101  endif
102  print *,'Creation de la famille 0'
103 C
104 C ** Creation des familles de noeuds
105  call efg2fc(fid,maa,nomgro,ind,ngroup,ent,nent,med_noeud,
106  & typgeo,indtmp,0,cret)
107  print *,cret
108  if (cret .ne. 0 ) then
109  print *,'Erreur creation des familles de noeud'
110  call efexit(-1)
111  endif
112  print *,'Creation des familles de noeuds dans test19.med'
113 C
114 C ** Creation des familles de mailles
115  call efg2fc(fid,maa,nomgro,ind,ngroup,ent,nent,med_maille,
116  & geo,indgeo,ngeo,cret)
117  print *,cret
118  if (cret .ne. 0 ) then
119  print *,'Erreur creation des familles de maille'
120  call efexit(-1)
121  endif
122  print *,'Creation des familles de mailles dans test19.med'
123 C
124 C ** Fermeture du fichier
125  call efferm (fid,cret)
126  print *,cret
127  if (cret .ne. 0 ) then
128  print *,'Erreur fermeture du fichier'
129  call efexit(-1)
130  endif
131  print *,'Fermeture du fichier'
132 C
133  end