MED fichier
f/test6.f
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 : test6.f
20 C *
21 C * - Description : exemples d'ecriture d'elements dans un maillage MED
22 C *
23 C ******************************************************************************
24  program test6
25 C
26  implicit none
27  include 'med.hf'
28 C
29 C
30  integer*8 fid
31  integer cret
32 
33  integer mdim,nse2,ntr3,sdim
34  parameter(nse2=5, ntr3=2, mdim=2, sdim=2)
35  integer se2 (2*nse2)
36  character*16 nomse2(nse2)
37  integer numse2(nse2),nufase2(nse2)
38 
39  character*16 nomcoo(2)
40  character*16 unicoo(2)
41 
42 
43  integer tr3 (3*ntr3)
44  character*16 nomtr3(ntr3)
45  integer numtr3(ntr3), nufatr3(ntr3)
46  character*64 maa
47  real*8 dt
48  parameter(dt = 0.0)
49 
50  data nomcoo /"x","y"/, unicoo /"cm","cm"/
51  data se2 / 1,2,1,3,2,4,3,4,2,3 /
52  data nomse2 /"se1","se2","se3","se4","se5" /
53  data numse2 / 1,2,3,4,5 /, nufase2 /-1,-1,0,-2,-3/
54  data tr3 /1,2,-5,-5,3,-4 /, nomtr3 /"tr1","tr2"/,
55  & numtr3 /4,5/
56  data nufatr3 /0,-1/, maa /"maa1"/
57 
58 C ** Ouverture du fichier
59  call mfiope(fid,'test6.med',med_acc_rdwr, cret)
60  print *,cret
61  if (cret .ne. 0 ) then
62  print *,'Erreur creation du fichier'
63  call efexit(-1)
64  endif
65 
66 C ** Creation du maillage maa de dimension 2 **
67  call mmhcre(fid,maa,mdim,sdim,
68  & med_unstructured_mesh,'un maillage pour test6',
69  & "",med_sort_dtit,med_cartesian,nomcoo,unicoo,cret)
70  print *,cret
71  if (cret .ne. 0 ) then
72  print *,'Erreur creation du maillage'
73  call efexit(-1)
74  endif
75 
76 C ** Ecriture des connectivites des segments **
77  call mmhcyw(fid,maa,med_no_dt,med_no_it,dt,
78  & med_descending_edge,med_seg2,med_descending,
79  & med_no_interlace,nse2,se2,cret)
80  print *,cret
81  if (cret .ne. 0 ) then
82  print *,'Erreur ecriture de la connectivite'
83  call efexit(-1)
84  endif
85 
86 C ** Ecriture (optionnelle) des noms des segments **
87  call mmheaw(fid,maa,med_no_dt,med_no_it,med_descending_edge,
88  & med_seg2,nse2,nomse2,cret)
89  print *,cret
90  if (cret .ne. 0 ) then
91  print *,'Erreur ecriture des noms'
92  call efexit(-1)
93  endif
94 
95 C ** Ecriture (optionnelle) des numeros des segments **
96  call mmhenw(fid,maa,med_no_dt,med_no_it,med_descending_edge,
97  & med_seg2,nse2,numse2,cret)
98  print *,cret
99  if (cret .ne. 0 ) then
100  print *,'Erreur ecriture des numeros'
101  call efexit(-1)
102  endif
103 
104 C ** Ecriture des numeros des familles des segments **
105  call mmhfnw(fid,maa,med_no_dt,med_no_it,med_descending_edge,
106  & med_seg2,nse2,nufase2,cret)
107  print *,cret
108  if (cret .ne. 0 ) then
109  print *,'Erreur ecriture des numéros de famille'
110  call efexit(-1)
111  endif
112 
113 C ** Ecriture des connectivites des triangles **
114  call mmhcyw(fid,maa,med_no_dt,med_no_it,dt,
115  & med_cell,med_tria3,med_descending,
116  & med_no_interlace,ntr3,tr3,cret)
117  print *,cret
118  if (cret .ne. 0 ) then
119  print *,'Erreur ecriture de la connectivite'
120  call efexit(-1)
121  endif
122 
123 C ** Ecriture (optionnelle) des noms des triangles **
124  call mmheaw(fid,maa,med_no_dt,med_no_it,med_cell,
125  & med_tria3,ntr3,nomtr3,cret)
126  print *,cret
127  if (cret .ne. 0 ) then
128  print *,'Erreur ecriture des noms'
129  call efexit(-1)
130  endif
131 
132 C ** Ecriture (optionnelle) des numeros des triangles **
133  call mmhenw(fid,maa,med_no_dt,med_no_it,med_cell,
134  & med_tria3,ntr3,numtr3,cret)
135  print *,cret
136  if (cret .ne. 0 ) then
137  print *,'Erreur ecriture des numeros'
138  call efexit(-1)
139  endif
140 
141 C ** Ecriture des numeros des familles des triangles **
142  call mmhfnw(fid,maa,med_no_dt,med_no_it,med_cell,
143  & med_tria3,ntr3,nufatr3,cret)
144  print *,cret
145  if (cret .ne. 0 ) then
146  print *,'Erreur ecriture des numeros de famille'
147  call efexit(-1)
148  endif
149 
150 C ** Fermeture du fichier **
151  call mficlo(fid,cret)
152  print *,cret
153  if (cret .ne. 0 ) then
154  print *,'Erreur a la fermeture du fichier'
155  call efexit(-1)
156  endif
157 C
158  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
mmhcyw
subroutine mmhcyw(fid, name, numdt, numit, dt, entype, geotype, cmode, swm, n, con, cret)
Cette routine permet d'écrire dans un maillage le tableau des connectivités pour un type géométrique ...
Definition: medmesh.f:578
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
test6
program test6
Definition: test6.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
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42