1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
25
26 implicit none
27 include 'med.hf'
28
29 integer*8 fid
30 integer cret,mdim,sdim
31 parameter(mdim = 2, sdim = 2)
32 character*64 maa
33 integer ni, n
34 parameter(ni=4, n=3)
35 integer index(ni)
36 character*16 nom(n)
37 integer num(n),fam(n)
38 integer con(16)
39
40
41 character*16 nomcoo(2)
42 character*16 unicoo(2)
43
44 data con / 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16 /
45 data nom / "poly1", "poly2", "poly3"/
46 data num / 1,2,3 /, fam /0,-1,-2/
47 data index /1,6,12,17/
48 data maa /"maa1"/
49 data nomcoo /"x","y"/, unicoo /"cm","cm"/
50
51
52 call mfiope(fid,
'test23.med',med_acc_rdwr, cret)
53 print *,cret
54 if (cret .ne. 0 ) then
55 print *,'Erreur creation du fichier'
56 call efexit(-1)
57 endif
58 print *,'Creation du fichier test23.med'
59
60
61 call mmhcre(fid,maa,mdim,sdim,
62 & med_unstructured_mesh,'un maillage pour test 23',
63 & "",med_sort_dtit,med_cartesian,nomcoo,unicoo,cret)
64 print *,cret
65 if (cret .ne. 0 ) then
66 print *,'Erreur creation du maillage'
67 call efexit(-1)
68 endif
69 print *,'Creation du maillage'
70
71
72 call mmhpgw(fid,maa,med_no_dt,med_no_it,med_undef_dt,med_cell,
73 & med_nodal,ni,index,con,cret)
74 if (cret .ne. 0 ) then
75 print *,'Erreur ecriture des connectivite polygones'
76 call efexit(-1)
77 endif
78 print *,cret
79 print *,'Ecriture des connectivites des mailles de type
80 & MED_POLYGONE'
81
82
83 call mmheaw(fid,maa,med_no_dt,med_no_it,med_cell,
84 & med_polygon,n,nom,cret)
85 print *,cret
86 if (cret .ne. 0 ) then
87 print *,'Erreur ecriture des noms polygones'
88 call efexit(-1)
89 endif
90 print *,'Ecriture des noms des polygones'
91
92
93 call mmhenw(fid,maa,med_no_dt,med_no_it,med_cell,
94 & med_polygon,n,num,cret)
95 if (cret .ne. 0 ) then
96 print *,'Erreur ecriture des numeros polygones'
97 call efexit(-1)
98 endif
99 print *,cret
100 print *,'Ecriture des numeros des polygones'
101
102
103 call mmhfnw(fid,maa,med_no_dt,med_no_it,med_cell,
104 & med_polygon,n,fam,cret)
105 if (cret .ne. 0 ) then
106 print *,'Erreur ecriture des numeros de famille polygones'
107 call efexit(-1)
108 endif
109 print *,cret
110 print *,'Ecriture des numeros de familles des polygones'
111
112
114 print *,cret
115 if (cret .ne. 0 ) then
116 print *,'Erreur fermeture du fichier'
117 call efexit(-1)
118 endif
119 print *,'Fermeture du fichier'
120
121 end
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
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.
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.
subroutine mmhpgw(fid, name, numdt, numit, dt, entype, cmode, isize, index, con, cret)
subroutine mmhfnw(fid, name, numdt, numit, entype, geotype, n, num, cret)
subroutine mmhenw(fid, name, numdt, numit, entype, geotype, n, num, cret)