MED fichier
test17.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2017 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 : test17.f90
20 ! *
21 ! * - Description : lecture d'elements de maillages MED ecrits par test16
22 ! * via les routines de niveau 2
23 ! * - equivalent a test17.f90
24 ! *
25 ! ******************************************************************************
26 
27 program test17
28 
29  implicit none
30  include 'med.hf90'
31 
32  integer :: cret,ret, fid, nse2, mdim, sdim
33  integer, allocatable, dimension(:) ::se2
34  character*16, allocatable, dimension(:) ::nomse2
35  integer, allocatable, dimension(:) ::numse2,nufase2
36  integer ntr3
37  integer, allocatable, dimension(:) ::tr3
38  character*16, allocatable, dimension(:) ::nomtr3
39  integer, allocatable, dimension(:) ::numtr3
40  integer, allocatable, dimension(:) ::nufatr3
41  character*64 :: maa
42  character*200 :: desc
43  integer :: inoele1,inuele1,inoele2,inuele2,ifaele1,ifaele2
44  integer tse2,ttr3
45  integer i,type,rep,nstep,stype
46  integer chgt,tsf
47  character*16 nomcoo(2)
48  character*16 unicoo(2)
49  character*16 dtunit
50 
51  ! ** Ouverture du fichier test16.med en lecture seule **
52  call mfiope(fid,'test16.med',med_acc_rdonly, cret)
53  print *,cret
54 
55  ! ** Lecture des informations sur le 1er maillage **
56  if (cret.eq.0) then
57  call mmhmii(fid,1,maa,sdim,mdim,type,desc,dtunit,stype,nstep,rep,nomcoo,unicoo,cret)
58  print *,"Maillage de nom : ",maa," et de dimension ",mdim
59  endif
60  print *,cret
61 
62  ! ** Lecture du nombre de triangles et de segments **
63  if (cret.eq.0) then
64  call mmhnme(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,med_connectivity,med_descending,chgt,tsf,nse2,cret)
65  endif
66  print *,cret
67 
68  if (cret.eq.0) then
69  call mmhnme(fid,maa,med_no_dt,med_no_it,med_cell,med_tria3,med_connectivity,med_descending,chgt,tsf,ntr3,cret)
70  endif
71  print *,cret
72 
73  print *,"Nombre de MED_SEG2 : ",nse2," - nombre de MED_TRIA3 : ",ntr3
74 
75  ! ** Allocations memoire **
76  tse2 = 2;
77  allocate(se2(tse2*nse2),nomse2(nse2),numse2(nse2),nufase2(nse2),stat=ret)
78  ttr3 = 3;
79  allocate(tr3(ntr3*ttr3),nomtr3(ntr3),numtr3(ntr3),nufatr3(ntr3),stat=ret)
80 
81  ! ** Lecture des aretes segments MED_SEG2 :
82  ! - Connectivite,
83  ! - Noms (optionnel)
84  ! - Numeros (optionnel)
85  ! - Numeros de familles **
86  if (cret.eq.0) then
87  call mmhelr(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,med_descending,med_no_interlace,se2,&
88  inoele1,nomse2,inuele1,numse2,ifaele1,nufase2,cret)
89  endif
90  print *,cret
91 
92 
93  ! ** lecture des mailles triangles MED_TRIA3 :
94  ! - Connectivite,
95  ! - Noms (optionnel)
96  ! - Numeros (optionnel)
97  ! - Numeros de familles **
98  if (cret.eq.0) then
99  call mmhelr(fid,maa,med_no_dt,med_no_it,med_cell,med_tria3,med_descending,med_no_interlace,tr3,&
100  inoele2,nomtr3,inuele2,numtr3,ifaele2,nufatr3,cret)
101  endif
102  print *,cret
103 
104  ! ** Fermeture du fichier **
105  call mficlo(fid,cret)
106  print *,cret
107 
108  ! ** Affichage **
109  if (cret.eq.0) then
110  print *,"Connectivite des segments : ",se2
111 
112  if (inoele1 .eq. med_true) then
113  print *,"Noms des segments : ",nomse2
114  endif
115 
116  if (inuele1 .eq. med_true) then
117  print *,"Numeros des segments : ",numse2
118  endif
119 
120  print *,"Numeros des familles des segments : ",nufase2
121 
122 
123  print *,"Connectivite des triangles : ",tr3
124 
125  if (inoele2 .eq. med_true) then
126  print *,"Noms des triangles :", nomtr3
127  endif
128 
129  if (inuele2 .eq. med_true) then
130  print *,"Numeros des triangles :", numtr3
131  endif
132 
133  print *,"Numeros des familles des triangles :", nufatr3
134 
135  end if
136 
137 
138  ! ** Nettoyage memoire **
139  deallocate(se2,nomse2,numse2,nufase2);
140  deallocate(tr3,nomtr3,numtr3,nufatr3);
141 
142  ! ** Code retour
143  call efexit(cret)
144 
145  end program test17
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
Cette routine permet de lire le nombre d'entités dans un maillage pour une séquence de calcul donnée...
Definition: medmesh.f:525
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Cette routine permet de lire les informations relatives à un maillage dans un fichier.
Definition: medmesh.f:106
program test17
Definition: test17.f90:27
subroutine mmhelr(fid, name, numdt, numit, entype, geotype, cmode, swm, con, iname, nname, inum, num, ifam, fam, cret)
Cette routine permet la lecture d'un type d'élément d'un maillage non structuré pour une séquence de ...
Definition: medmesh.f:743
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41