MED fichier: Fichier source de test6.f

MED fichier

test6.f
Aller à la documentation de ce fichier.
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2021 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
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
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
test6
program test6
Definition: test6.f:24
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
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
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
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
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