MED fichier
test8.f
Aller à la documentation de ce fichier.
1C* This file is part of MED.
2C*
3C* COPYRIGHT (C) 1999 - 2020 EDF R&D, CEA/DEN
4C* MED is free software: you can redistribute it and/or modify
5C* it under the terms of the GNU Lesser General Public License as published by
6C* the Free Software Foundation, either version 3 of the License, or
7C* (at your option) any later version.
8C*
9C* MED is distributed in the hope that it will be useful,
10C* but WITHOUT ANY WARRANTY; without even the implied warranty of
11C* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12C* GNU Lesser General Public License for more details.
13C*
14C* You should have received a copy of the GNU Lesser General Public License
15C* along with MED. If not, see <http://www.gnu.org/licenses/>.
16C*
17
18C ******************************************************************************
19C * - Nom du fichier : test8.f
20C *
21C * - Description : exemple d'ecriture des familles d'un maillage MED
22C *
23C *****************************************************************************
24 program test8
25C
26 implicit none
27 include 'med.hf'
28C
29 integer*8 fid
30 integer cret
31
32 character*64 maa
33 integer mdim, sdim
34 character*64 nomfam
35 integer numfam
36 integer ngro
37 character*80 gro
38 integer nfamn
39 character*16 str
40 character*16 nomcoo(2)
41 character*16 unicoo(2)
42
43 parameter( mdim = 2, nfamn = 2 , sdim = 2)
44 data maa /"maa1"/
45 data nomcoo /"x","y"/, unicoo /"cm","cm"/
46
47C ** Creation du fichier test8.med **
48 call mfiope(fid,'test8.med',med_acc_rdwr, cret)
49 print *,cret
50 if (cret .ne. 0 ) then
51 print *,'Erreur creation du fichier'
52 call efexit(-1)
53 endif
54
55C ** Creation du maillage maa de dimension 2 **
56 call mmhcre(fid,maa,mdim,sdim,med_unstructured_mesh,
57 & 'un maillage pour test8',"",med_sort_dtit,
58 & med_cartesian,nomcoo,unicoo,cret)
59 print *,cret
60 if (cret .ne. 0 ) then
61 print *,'Erreur creation du maillage'
62 call efexit(-1)
63 endif
64
65C ** Ecriture des familles **
66C * Conventions :
67C - Toujours creer une famille de numero 0 ne comportant aucun attribut
68C ni groupe (famille de reference pour les noeuds ou les elements
69C qui ne sont rattaches a aucun groupe ni attribut)
70C - Les numeros de familles de noeuds sont > 0
71C - Les numeros de familles des elements sont < 0
72C - Rien d'imposer sur les noms de familles
73C ** **
74
75C * Creation de la famille 0 **
76 numfam = 0
77 nomfam="FAMILLE_0"
78 ngro = 0
79 call mfacre(fid,maa,nomfam,numfam,ngro,gro,cret)
80 print *,cret
81 if (cret .ne. 0 ) then
82 print *,'Erreur creation de la famille 0'
83 call efexit(-1)
84 endif
85
86C * Creation pour correspondre aux cas tests precedents, 3 familles *
87C * d'elements (-1,-2,-3) et deux familles de noeuds (1,2) *
88 do numfam=-1,-3,-1
89 write(str,'(I1.0)') (-numfam)
90 nomfam = "FAMILLE_ELEMENT_"//str
91 gro="groupe1"
92 ngro = 1
93 call mfacre(fid,maa,nomfam,numfam,ngro,gro,cret)
94 print *,cret
95 if (cret .ne. 0 ) then
96 print *,'Erreur creation de famille'
97 call efexit(-1)
98 endif
99 end do
100
101 do numfam=1,nfamn
102 write(str,'(I1.0)') numfam
103 nomfam = "FAMILLE_NOEUD_"//str
104 gro="groupe1"
105 ngro = 1
106 call mfacre(fid,maa,nomfam,numfam,ngro,gro,cret)
107 print *,cret
108 if (cret .ne. 0 ) then
109 print *,'Erreur creation de famille'
110 call efexit(-1)
111 endif
112 end do
113
114
115C * Fermeture du fichier *
116 call mficlo(fid,cret)
117 print *,cret
118 if (cret .ne. 0 ) then
119 print *,'Erreur fermeture du fichier'
120 call efexit(-1)
121 endif
122C
123 end
124
125
126
127
128
129
subroutine mfacre(fid, name, fname, fnum, ngro, gname, cret)
Cette routine permet la création d'une famille portant sur les entités d'un maillage.
Definition medfamily.f:19
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition medfile.f:42
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition medfile.f:82
subroutine mmhcre(fid, name, sdim, mdim, mtype, desc, dtunit, stype, atype, aname, aunit, cret)
Cette routine permet de créer un maillage dans un fichier.
Definition medmesh.f:20
#define str(s)
Definition mdump2.c:127
program test8
Definition test8.f:24