MED fichier
test8.f
Aller à la documentation de ce fichier.
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2020 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 : test8.f
20 C *
21 C * - Description : exemple d'ecriture des familles d'un maillage MED
22 C *
23 C *****************************************************************************
24  program test8
25 C
26  implicit none
27  include 'med.hf'
28 C
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 
47 C ** 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 
55 C ** 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 
65 C ** Ecriture des familles **
66 C * Conventions :
67 C - Toujours creer une famille de numero 0 ne comportant aucun attribut
68 C ni groupe (famille de reference pour les noeuds ou les elements
69 C qui ne sont rattaches a aucun groupe ni attribut)
70 C - Les numeros de familles de noeuds sont > 0
71 C - Les numeros de familles des elements sont < 0
72 C - Rien d'imposer sur les noms de familles
73 C ** **
74 
75 C * 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 
86 C * Creation pour correspondre aux cas tests precedents, 3 familles *
87 C * 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 
115 C * 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
122 C
123  end
124 
125 
126 
127 
128 
129 
mfacre
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
mmhcre
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
str
#define str(s)
Definition: mdump2.c:127
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
test8
program test8
Definition: test8.f:24
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42