MED fichier
test9.f90
Aller à la documentation de ce fichier.
1!* This file is part of MED.
2!*
3!* COPYRIGHT (C) 1999 - 2020 EDF R&D, CEA/DEN
4!* MED is free software: you can redistribute it and/or modify
5!* it under the terms of the GNU Lesser General Public License as published by
6!* the Free Software Foundation, either version 3 of the License, or
7!* (at your option) any later version.
8!*
9!* MED is distributed in the hope that it will be useful,
10!* but WITHOUT ANY WARRANTY; without even the implied warranty of
11!* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12!* GNU Lesser General Public License for more details.
13!*
14!* You should have received a copy of the GNU Lesser General Public License
15!* along with MED. If not, see <http://www.gnu.org/licenses/>.
16!*
17
18! ******************************************************************************
19! * - Nom du fichier : test9.f90
20! *
21! * - Description : lecture des familles d'un maillage MED
22! *
23! ******************************************************************************
24program test9
25
26 implicit none
27 include 'med.hf90'
28!
29 integer*8 fid
30 integer ret,cret
31 character*64 maa
32 integer mdim,sdim
33 integer nfam
34 integer i,j
35 integer ngro,natt
36 character*80, allocatable, dimension (:) :: gro
37 integer, allocatable, dimension (:) :: attid
38 integer, allocatable, dimension (:) :: attval
39 character*200, allocatable, dimension (:) :: attdes
40 character*200 desc
41 character*64 nomfam
42 integer numfam
43 integer type
44 character(16) :: dtunit
45 integer nstep, stype, atype
46 character*16 nomcoo(2)
47 character*16 unicoo(2)
48
49
50! ** Ouverture du fichier test8.med en lecture seule **
51 call mfiope(fid,'test8.med',med_acc_rdonly, cret)
52 print *,cret
53
54! ** Lecture des infos sur le 1er maillage **
55 if (cret.eq.0) then
56 call mmhmii(fid,1,maa,sdim,mdim,type,desc,dtunit,stype,nstep,atype,nomcoo,unicoo,cret)
57 print *,"Maillage de nom : ",maa," et de dimension : ", mdim
58 endif
59 print *,cret
60
61! ** Lecture du nombre de famille **
62 if (cret .eq. 0) then
63 call mfanfa(fid,maa,nfam,cret)
64 print *,' Nombre de familles a lire : ',nfam
65 endif
66 print *,cret
67
68! ** Lecture de chaque famille **
69 if (cret .eq. 0) then
70 do i=1,nfam
71
72! ** Lecture du nombre de groupe **
73 if (cret .eq. 0) then
74 call mfanfg(fid,maa,i,ngro,cret)
75 endif
76 print *,cret
77
78! ** Lecture du nombre d'attributs pour les
79! fichiers 2.3 **
80 if (cret .eq. 0) then
81 call mfaona(fid,maa,i,natt,cret)
82 endif
83 print *,cret
84
85 print *,"Famille ",i," a ",ngro," groupes et ", natt, " attributs"
86
87! ** Lecture de : nom,numero,attributs,groupes **
88 if (cret .eq. 0) then
89 allocate(gro(ngro), attid(natt), attval(natt), attdes(natt),stat=ret)
90 print *,ret
91
92 call mfaofi(fid,maa,i,nomfam,attid,attval,attdes,numfam,gro,cret)
93 print *,cret
94 print *,"Famille de nom ",nomfam," et de numero ",numfam
95 do j=1,natt
96 print *,"attid = ", attid(j)
97 print *,"attval = ", attval(j)
98 print *,"attdes =", attdes(j)
99 enddo
100 do j=1,ngro
101 print *,"gro = ",gro(j)
102 enddo
103
104 deallocate(gro, attval, attid, attdes)
105 endif
106 enddo
107 endif
108
109
110! ** Fermeture du fichier **
111 call mficlo(fid,cret)
112 print *,cret
113
114! ** Code retour
115 call efexit(cret)
116
117 end program test9
118
119
subroutine mfanfg(fid, maa, it, n, cret)
Definition medfamily.f:61
subroutine mfaofi(fid, maa, it, fam, attnum, attval, attdes, num, gro, cret)
Definition medfamily.f:126
subroutine mfanfa(fid, maa, n, cret)
Definition medfamily.f:38
subroutine mfaona(fid, maa, it, n, cret)
Definition medfamily.f:102
subroutine mfiope(fid, name, access, cret)
Definition medfile.f:42
subroutine mficlo(fid, cret)
Definition medfile.f:82
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Definition medmesh.f:110
program test9
Definition test9.f90:24