MED fichier: Fichier source de test19.f

MED fichier

- Documentation MED
- Guides d'utilisation
- Guides de référence

test19.f
Aller à la documentation de ce fichier.
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2017 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 C Cas test obsolete avec MED 3.0, on laisse les appels à l'API 2.3
31 C
32 integer cret
33 integer fid
34 character *32 maa
35 parameter(maa = "maillage_test19")
36 character*200 des
37 parameter(des = "un maillage pour test19")
38 integer mdim
39 parameter(mdim = 2)
40 C Donnees de tests pour MEDgro2FamCr()
41 C Les noeuds/mailles sont numerotes de 1 a 5 et les
42 C groupes de 1 a 3.
43 C Au depart, on a :
44 C - G1 : 1,2
45 C - G2 : 3,4,6
46 C - G3 : 1,4
47 C Au retour, on foit avoir 4 familles de noeuds + 4 familles de mailles
48 C + la famille 0 dans le fichier :
49 C - F0 : 5 - groupes : aucun groupe par defaut (convention habituelle).
50 C - F1 : 1 - groupes : G1,G3
51 C - F2 : 2 - groupes : G1
52 C - F3 : 3,6 - groupes : G2
53 C - F4 : 4 - groupes : G2,G3
54 C
55 integer ngroup
56 parameter(ngroup = 3)
57 integer nent
58 parameter(nent = 6)
59 character*80 nomgro(ngroup)
60 integer ent(7)
61 integer ind(ngroup+1)
62 integer ngeo
63 parameter(ngeo = 3)
64 integer geo(ngeo)
65 integer indgeo(ngeo+1)
66 character*200 attdes,gro
67 integer attval,attide
68 integer typgeo
69 integer indtmp
70 C
71 data nomgro / "GROUPE1","GROUPE2","GROUPE3" /
72 data ent / 1,2, 3,4,6, 1,4 /
73 data ind / 1, 3, 6, 8 /
74 data geo / med_seg2, med_tria3, med_tetra4 /
75 data indgeo / 1,4,6,7 /
76 C
77 C ** Creation du fichier test19.med
78 call efouvr(fid,'test19.med',med_lecture_ecriture, cret)
79 print *,cret
80 if (cret .ne. 0 ) then
81 print *,'Erreur creation du fichier'
82 call efexit(-1)
83 endif
84 print *,'Creation du fichier test19.med'
85 C
86 C ** Creation du maillage
87 call efmaac(fid,maa,mdim,med_non_structure,des,cret)
88 print *,cret
89 if (cret .ne. 0 ) then
90 print *,'Erreur creation du maillage'
91 call efexit(-1)
92 endif
93 print *,'Creation du maillage'
94 C
95 C ** Creation de la famille 0
96 call effamc(fid,maa,'FAMILLE_0',0,attide,attval,attdes,0,gro,0,
97 & cret)
98 print *,cret
99 if (cret .ne. 0 ) then
100 print *,'Erreur creation de la famille 0'
101 call efexit(-1)
102 endif
103 print *,'Creation de la famille 0'
104 C
105 C ** Creation des familles de noeuds
106 call efg2fc(fid,maa,nomgro,ind,ngroup,ent,nent,med_noeud,
107 & typgeo,indtmp,0,cret)
108 print *,cret
109 if (cret .ne. 0 ) then
110 print *,'Erreur creation des familles de noeud'
111 call efexit(-1)
112 endif
113 print *,'Creation des familles de noeuds dans test19.med'
114 C
115 C ** Creation des familles de mailles
116 call efg2fc(fid,maa,nomgro,ind,ngroup,ent,nent,med_maille,
117 & geo,indgeo,ngeo,cret)
118 print *,cret
119 if (cret .ne. 0 ) then
120 print *,'Erreur creation des familles de maille'
121 call efexit(-1)
122 endif
123 print *,'Creation des familles de mailles dans test19.med'
124 C
125 C ** Fermeture du fichier
126 call efferm (fid,cret)
127 print *,cret
128 if (cret .ne. 0 ) then
129 print *,'Erreur fermeture du fichier'
130 call efexit(-1)
131 endif
132 print *,'Fermeture du fichier'
133 C
134 end
test19
program test19
Definition: test19.f:24