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 - 2016 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
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
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 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
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
program test6
Definition: test6.f:24
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
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41
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