1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
26
27 implicit none
28 include 'med.hf'
29
30
31 integer*8 fid
32 integer cret
33 character*64 maa , equ
34 character*200 des
35 integer mdim ,ncor, sdim
36 integer cor(6)
37 character*16 nomcoo(3)
38 character*16 unicoo(3)
39
40 parameter(maa ="maa1",mdim = 3,ncor = 3 , sdim=3)
41 data cor /1,2,3,4,5,6/, equ / "equivalence"/
42 data des / "equivalence sur les mailles MED_TRIA3" /
43 data nomcoo /"x","y","z"/, unicoo /"cm","cm","cm"/
44
45
46
47 call mfiope(fid,
'test12.med',med_acc_rdwr, cret)
48 print *,cret
49 if (cret .ne. 0 ) then
50 print *,'Erreur creation du fichier'
51 call efexit(-1)
52 endif
53
54
55
56 call mmhcre(fid,maa,mdim,sdim,med_unstructured_mesh,
57 & 'Un maillage pour test12',"",
58 & med_sort_dtit,med_cartesian,nomcoo,unicoo,cret)
59 print *,cret
60 if (cret .ne. 0 ) then
61 print *,'Erreur creation du maillage'
62 call efexit(-1)
63 endif
64
65
66 call meqcre(fid,maa,equ,des,cret)
67 print *,cret
68 if (cret .ne. 0 ) then
69 print *,'Erreur creation equivalence'
70 call efexit(-1)
71 endif
72
73
74 call meqcow(fid,maa,equ,med_no_dt,med_no_it,med_cell,
75 & med_tria3,ncor,cor,cret)
76 print *,cret
77 if (cret .ne. 0 ) then
78 print *,'Erreur ecriture de correspondances'
79 call efexit(-1)
80 endif
81
82
84 print *,cret
85 if (cret .ne. 0 ) then
86 print *,'Erreur fermeture du fichier'
87 call efexit(-1)
88 endif
89
90 end
subroutine meqcre(fid, maa, eq, des, cret)
subroutine meqcow(fid, maa, eq, numdt, numit, typent, typgeo, n, corr, cret)
subroutine mfiope(fid, name, access, cret)
subroutine mficlo(fid, cret)
subroutine mmhcre(fid, name, sdim, mdim, mtype, desc, dtunit, stype, atype, aname, aunit, cret)