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
34 character*200 des
35 integer nmaa, mdim , nnoe, type, ind,sdim
36 integer numglb(100),i
37 character*16 nomcoo(2)
38 character*16 unicoo(2)
39 character(16) :: dtunit
40 real*8 coo(8)
41 integer nstep, stype, atype,chgt,tsf
42 real*8 dt
43 parameter(mdim = 2, maa = "maa1",sdim=2)
44 parameter(dt = 0.0)
45 data coo /0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0/
46 data nomcoo /"x","y"/, unicoo /"cm","cm"/
47
48
49
50 call mfiope(fid,
'test31.med',med_acc_rdwr, cret)
51 print *,cret
52 if (cret .ne. 0 ) then
53 print *,'Erreur ouverture du fichier test31.med'
54 call efexit(-1)
55 endif
56
57
58
59 nnoe=4
60 call mmhcre(fid,maa,mdim,sdim,
61 & med_unstructured_mesh,
62 & 'un premier maillage pour test4',
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
70
71
72 call mmhcow(fid,maa,med_no_dt,med_no_it,dt,
73 & med_full_interlace,nnoe,coo,cret)
74 print *,cret
75 if (cret .ne. 0 ) then
76 print *,'Erreur ecriture des coordonnees des noeuds'
77 call efexit(-1)
78 endif
79
80 print '(A,I1,A,A4,A,I1,A,I4)','maillage '
81 & ,ind,' de nom ',maa,' et de dimension ',mdim,
82 & ' comportant le nombre de noeud ',nnoe
83
84
85
86 if (nnoe.gt.100) nnoe=100
87
88 do i=1,nnoe
89 numglb(i)=i+100
90 enddo
91
92
93 call mmhgnw(fid,maa,med_no_dt,med_no_it,med_node,med_none,
94 & nnoe,numglb,cret)
95
96 if (cret .ne. 0 ) then
97 print *,'Erreur ecriture numerotation globale '
98 call efexit(-1)
99 endif
100
102 print *,cret
103 if (cret .ne. 0 ) then
104 print *,'Erreur fermeture du fichier'
105 call efexit(-1)
106 endif
107
108 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 mmhgnw(fid, name, numdt, numit, entype, geotype, n, num, cret)
subroutine mmhcow(fid, name, numdt, numit, dt, swm, n, coo, cret)