MED fichier: Fichier source de test6.f

MED fichier

- Documentation MED
- Guides d'utilisation
- Guides de référence

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