MED fichier
test25.f
Aller à la documentation de ce fichier.
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2023 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 : test25.f
20 C *
21 C * - Description : ecriture de mailles MED_POLYEDRE dans un maillage MED
22 C *
23 C ******************************************************************************
24  program test25
25 C
26  implicit none
27  include 'med.hf'
28 C
29  integer*8 fid
30  integer cret,mdim, sdim
31  parameter(mdim = 3, sdim = 3)
32  character*64 maa
33  integer n
34  parameter(n=2)
35 C Connectivite nodale
36  integer np,nf
37  parameter(nf=9,np=3)
38  integer indexp(np),indexf(nf)
39  integer conn(24)
40 C Connectivite descendante
41  integer np2,nf2
42  parameter(nf2=8,np2=3)
43  integer indexp2(np2),indexf2(nf2)
44  integer conn2(nf2)
45  character*16 nom(n)
46  integer num(n),fam(n)
47 C ** tables des noms et des unites des coordonnees **
48 C profil : (dimension) **
49  character*16 nomcoo(3)
50  character*16 unicoo(3)
51 C
52  data indexp / 1,5,9 /
53  data indexf / 1,4,7,10,13,16,19,22,25 /
54  data conn / 1,2,3,4,5,6,7,8,9,10,11,12,13,14,
55  & 15,16,17,18,19,20,21,22,23,24 /
56  data indexp2 / 1,5,9 /
57  data indexf2 / med_tria3,med_tria3,med_tria3,med_tria3,
58  & med_tria3,med_tria3,med_tria3,med_tria3 /
59  data conn2 / 1,2,3,4,5,6,7,8 /
60  data nom / "poly1", "poly2"/
61  data num / 1,2 /, fam / 0,-1 /
62  data maa /"maa1"/
63  data nomcoo /"x","y","z"/, unicoo /"cm","cm","cm"/
64 
65 C ** Creation du fichier test25.med **
66  call mfiope(fid,'test25.med',med_acc_rdwr, cret)
67  print *,cret
68  if (cret .ne. 0 ) then
69  print *,'Erreur creation du fichier'
70  call efexit(-1)
71  endif
72  print *,'Creation du fichier test25.med'
73 
74 C ** Creation du maillage **
75  call mmhcre(fid,maa,mdim,sdim,
76  & med_unstructured_mesh,'un maillage pour test 25',
77  & "",med_sort_dtit,med_cartesian,nomcoo,unicoo,cret)
78  if (cret .ne. 0 ) then
79  print *,'Erreur creation du maillage'
80  call efexit(-1)
81  endif
82  print *,cret
83  print *,'Creation du maillage'
84 
85 C ** Ecriture des connectivites des mailles polyedres en mode nodal **
86  call mmhphw(fid,maa,med_no_dt,med_no_it,med_undef_dt,med_cell,
87  & med_nodal,np,indexp,nf,indexf,conn,cret)
88  print *,cret
89  if (cret .ne. 0 ) then
90  print *,'Erreur ecriture connectivite des polyedres'
91  call efexit(-1)
92  endif
93  print *,'Ecriture des connectivites des mailles
94  & de type MED_POLYEDRE'
95  print *,'Description nodale'
96 
97 C ** Ecriture des connectivites des mailles polyedres en mode descendant **
98  call mmhphw(fid,maa,med_no_dt,med_no_it,med_undef_dt,med_cell,
99  & med_descending,np2,indexp2,nf2,indexf2,conn2,cret)
100  print *,cret
101  if (cret .ne. 0 ) then
102  print *,'Erreur ecriture connectivite des polyedres'
103  call efexit(-1)
104  endif
105  print *,'Ecriture des connectivites des mailles
106  & de type MED_POLYEDRE'
107  print *,'Description descendante'
108 
109 C ** Ecriture des noms des mailles polyedres **
110  call mmheaw(fid,maa,med_no_dt,med_no_it,med_cell,
111  & med_polyhedron,n,nom,cret)
112  print *,cret
113  if (cret .ne. 0 ) then
114  print *,'Erreur ecriture noms des polyedres'
115  call efexit(-1)
116  endif
117  print *,'Ecriture des noms des polyedress'
118 
119 C ** Ecriture des numeros des mailles polyedres **
120  call mmhenw(fid,maa,med_no_dt,med_no_it,med_cell,
121  & med_polyhedron,n,num,cret)
122  print *,cret
123  if (cret .ne. 0 ) then
124  print *,'Erreur ecriture numeros des polyedres'
125  call efexit(-1)
126  endif
127  print *,'Ecriture des numeros des polyedres'
128 
129 C ** Ecriture des numeros des familles des segments **
130  call mmhfnw(fid,maa,med_no_dt,med_no_it,med_cell,
131  & med_polyhedron,n,fam,cret)
132  print *,cret
133  if (cret .ne. 0 ) then
134  print *,'Erreur ecriture numeros de familles polyedres'
135  call efexit(-1)
136  endif
137  print *,'Ecriture des numeros de familles des polyedres'
138 
139 C ** Fermeture du fichier **
140  call mficlo(fid,cret)
141  print *,cret
142  if (cret .ne. 0 ) then
143  print *,'Erreur fermeture du fichier'
144  call efexit(-1)
145  endif
146  print *,'Fermeture du fichier'
147 C
148  end
mmhfnw
subroutine mmhfnw(fid, name, numdt, numit, entype, geotype, n, num, cret)
Cette routine permet l'écriture des numéros de famille d'un type d'entité d'un maillage.
Definition: medmesh.f:466
mmheaw
subroutine mmheaw(fid, mname, numdt, numit, entype, geotype, n, ename, cret)
Cette routine permet d'écrire les noms d'un type d'entité d'un maillage.
Definition: medmesh.f:508
test25
program test25
Definition: test25.f:24
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
mmhenw
subroutine mmhenw(fid, name, numdt, numit, entype, geotype, n, num, cret)
Cette routine permet d'écrire les numéros d'un type d'entité d'un maillage.
Definition: medmesh.f:424
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
mmhphw
subroutine mmhphw(fid, name, numdt, numit, dt, entype, cmode, fisize, findex, nisize, nindex, con, cret)
Cette routine permet l'écriture dans un maillage des connectivités de polyèdres.
Definition: medmesh.f:933
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42