1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
27
28 implicit none
29 include 'med.hf'
30
31 integer*8 fid
32 integer cret
33
34 integer mdim,sdim
35
36 character*64 maa
37
38 integer nnoe
39 parameter(mdim=2,maa="maa1",nnoe=4,sdim=2)
40
41 real*8 coo(mdim*nnoe)
42
43 character*16 nomcoo(mdim), unicoo(mdim)
44
45
46
47 character*16 nomnoe(nnoe)
48 integer numnoe(nnoe), nufano(nnoe)
49 real*8 dt
50 parameter(dt=0.0)
51
52 data coo /0.0, 0.0, 1.0, 0.0, 0.0, 1.0, 1.0, 1.0/
53 data nomcoo /"x","y"/, unicoo /"cm","cm"/
54 data nomnoe /"nom1","nom2","nom3","nom4"/
55 data numnoe /1,2,3,4/,nufano /0,1,2,2/
56
57
58 call mfiope(fid,
'test14.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
66 call mmhcre(fid,maa,mdim,sdim,med_unstructured_mesh,
67 & 'un maillage pour test14',"",med_sort_dtit,
68 & 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
76
77
78
79
80
81 call mmhnow(fid,maa,med_no_dt,med_no_it,dt,med_full_interlace,
82 & nnoe,coo,med_true,nomnoe,med_true,numnoe,
83 & med_true,nufano,cret)
84 print *,cret
85 if (cret .ne. 0 ) then
86 print *,'Erreur ecriture des noeuds'
87 call efexit(-1)
88 endif
89
90
92 print *,cret
93 if (cret .ne. 0 ) then
94 print *,'Erreur fermeture du fichier'
95 call efexit(-1)
96 endif
97
98 end
99
100
101
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 mmhnow(fid, name, numdt, numit, dt, swm, n, coo, iname, nname, inum, num, ifam, fam, cret)