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,cres,type,cnu
33 character*64 maa
34 character*80 nomu
35 character*200 desc
36 integer nmaa,i,mdim,edim,nstep,stype,atype
37
38
39
40
41
42
43 character*16 nomcoo(3)
44 character*16 unicoo(3)
45 character*16 dtunit
46 integer maa1exist,maa4exist
47
48
49 call mfiope(fid,
'test2.med',med_acc_rdonly, cret)
50 print *,cret
51 if (cret .ne. 0 ) then
52 print *,'Erreur ouverture du fichier en lecture'
53 call efexit(-1)
54 endif
55
56
57 call mfioex(fid,med_mesh,
"maa1", maa1exist, cret)
58 print *,cret
59 if (cret .ne. 0 ) then
60 print *,é'Erreur de test de prsence de maillage'
61 call efexit(-1)
62 endif
63 print *,"Maillage maa1 existe : ",maa1exist
64
65 call mfioex(fid,med_mesh,
"maa4", maa4exist, cret)
66 print *,cret
67 if (cret .ne. 0 ) then
68 print *,é'Erreur de test de prsence de maillage'
69 call efexit(-1)
70 endif
71 print *,"Maillage maa4 existe : ",maa4exist
72
73
75 print *,cret
76 if (cret .ne. 0 ) then
77 print *,'Erreur lecture du nombre de maillage'
78 call efexit(-1)
79 endif
80 print *,'Nombre de maillages = ',nmaa
81
82
83
84
85 do i=1,nmaa
86 call mmhmii(fid,i,maa,edim,mdim,
type,desc,
87 & dtunit,stype,nstep,atype,
88 & nomcoo,unicoo,cret)
89 call mmhunr(fid,maa,nomu,cnu)
90 print *,cret
91 if (cret .ne. 0 ) then
92 print *,'Erreur acces au maillage'
93 call efexit(-1)
94 endif
95 print '(A,I1,A,A4,A,I1,A,A65,A65)','maillage '
96 & ,i,' de nom ',maa,' et de dimension ',mdim,
97 & ' de description ',desc
98 if (type.eq.med_unstructured_mesh) then
99 print *,'Maillage non structure'
100 else
101 print *,'Maillage structure'
102 endif
103 print *,'Dimension espace ', edim
104 print *,'Dimension maillage ', mdim
105 if (cnu.eq.0) then
106 print *,'Nom universel : ',nomu
107 else
108 print *,'Pas de nom universel'
109 endif
110 print *,'dt unit = ', dtunit
111 print *,'sorting type =', stype
112 print *,'number of computing step =', nstep
113 print *,'coordinates axis type =', atype
114 print *,'coordinates axis name =', nomcoo(1),nomcoo(2)
115 print *,'coordinates axis units =', unicoo(1),unicoo(2)
116 enddo
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
subroutine mfioex(fid, class, oname, oexist, cret)
subroutine mfiope(fid, name, access, cret)
subroutine mficlo(fid, cret)
subroutine mmhunr(fid, mname, uname, cret)
subroutine mmhnmh(fid, n, cret)
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)