MED fichier
f/test6.f
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 : test6.f
20C *
21C * - Description : exemples d'ecriture d'elements dans un maillage MED
22C *
23C ******************************************************************************
24 program test6
25C
26 implicit none
27 include 'med.hf'
28C
29C
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
58C ** 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
66C ** 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
76C ** 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
86C ** 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
95C ** 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
104C ** 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
113C ** 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
123C ** 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
132C ** 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
141C ** 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
150C ** 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
157C
158 end
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
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
subroutine mmhcyw(fid, name, numdt, numit, dt, entype, geotype, cmode, swm, n, con, cret)
Definition medmesh.f:578
subroutine mmhfnw(fid, name, numdt, numit, entype, geotype, n, num, cret)
Definition medmesh.f:466
subroutine mmhenw(fid, name, numdt, numit, entype, geotype, n, num, cret)
Definition medmesh.f:424
program test6
Definition test6.f:24