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
30 integer*8 fid
31 integer cret
32
33
34 integer mdim, sdim
35
36 character*64 maa
37
38 integer nnoe
39
40
41 real*8 coo(8)
42
43
44 character*16 nomcoo(2)
45 character*16 unicoo(2)
46
47
48
49 character*16 nomnoe(4)
50 integer numnoe(4)
51 integer nufano(4)
52 real*8 dt
53
54 parameter(mdim = 2, maa = "maa1",nnoe = 4, sdim=2)
55 parameter(dt = 0.0)
56 data coo /0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0/
57 data nomcoo /"x","y"/, unicoo /"cm","cm"/
58 data nomnoe /"nom1","nom2","nom3","nom4"/
59 data numnoe /1,2,3,4/, nufano /0,1,2,2/
60
61
62 call mfiope(fid,
'test4.med',med_acc_rdwr, cret)
63 print *,cret
64 if (cret .ne. 0 ) then
65 print *,'Erreur creation du fichier'
66 call efexit(-1)
67 endif
68
69
70
71 call mmhcre(fid,maa,mdim,sdim,
72 & med_unstructured_mesh,'un premier maillage pour test4',
73 & "",med_sort_dtit,med_cartesian,nomcoo,unicoo,cret)
74 print *,cret
75 if (cret .ne. 0 ) then
76 print *,'Erreur creation du maillage'
77 call efexit(-1)
78 endif
79
80
81
82 call mmhcow(fid,maa,med_no_dt,med_no_it,dt,
83 & med_full_interlace,nnoe,coo,cret)
84 print *,cret
85 if (cret .ne. 0 ) then
86 print *,'Erreur ecriture des coordonnees des noeuds'
87 call efexit(-1)
88 endif
89
90
91 call mmheaw(fid,maa,med_no_dt,med_no_it,med_node,
92 & med_none,nnoe,nomnoe,cret)
93 print *,cret
94 if (cret .ne. 0 ) then
95 print *,'Erreur ecriture des noms des noeuds'
96 call efexit(-1)
97 endif
98
99
100 call mmhenw(fid,maa,med_no_dt,med_no_it,med_node,
101 & med_none,nnoe,numnoe,cret)
102 print *,cret
103 if (cret .ne. 0 ) then
104 print *,'Erreur ecriture des numeros des noeuds'
105 call efexit(-1)
106 endif
107
108
109
110 call mmhfnw(fid,maa,med_no_dt,med_no_it,med_node,
111 & med_none,nnoe,nufano,cret)
112 print *,cret
113 if (cret .ne. 0 ) then
114 print *,'Erreur ecriture des numeros de famille'
115 call efexit(-1)
116 endif
117
118
120 print *,cret
121 if (cret .ne. 0 ) then
122 print *,'Erreur fermeture du fichier'
123 call efexit(-1)
124 endif
125
126 end
127
128
129
130
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 mmhfnw(fid, name, numdt, numit, entype, geotype, n, num, cret)
subroutine mmhenw(fid, name, numdt, numit, entype, geotype, n, num, cret)
subroutine mmhcow(fid, name, numdt, numit, dt, swm, n, coo, cret)