MED fichier
test9.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2019 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 ! ******************************************************************************
24 program 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 mfiope(fid, name, access, cret)
Definition: medfile.f:42
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Definition: medmesh.f:110
subroutine mficlo(fid, cret)
Definition: medfile.f:82
program test9
Definition: test9.f90:24
subroutine mfanfa(fid, maa, n, cret)
Definition: medfamily.f:38
subroutine mfaona(fid, maa, it, n, cret)
Definition: medfamily.f:102
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